home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl-5.003.tar.gz / perl-5.003.tar / perl-5.003 / sv.c < prev    next >
C/C++ Source or Header  |  1996-02-27  |  73KB  |  3,678 lines
  1. /*    sv.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "I wonder what the Entish is for 'yes' and 'no'," he thought.
  12.  */
  13.  
  14. #include "EXTERN.h"
  15. #include "perl.h"
  16.  
  17. #ifdef OVR_DBL_DIG
  18. /* Use an overridden DBL_DIG */
  19. # ifdef DBL_DIG
  20. #  undef DBL_DIG
  21. # endif
  22. # define DBL_DIG OVR_DBL_DIG
  23. #else
  24. /* The following is all to get DBL_DIG, in order to pick a nice
  25.    default value for printing floating point numbers in Gconvert.
  26.    (see config.h)
  27. */
  28. #ifdef I_LIMITS
  29. #include <limits.h>
  30. #endif
  31. #ifdef I_FLOAT
  32. #include <float.h>
  33. #endif
  34. #ifndef HAS_DBL_DIG
  35. #define DBL_DIG    15   /* A guess that works lots of places */
  36. #endif
  37. #endif
  38.  
  39. #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
  40. #  define FAST_SV_GETS
  41. #endif
  42.  
  43. static SV *more_sv _((void));
  44. static XPVIV *more_xiv _((void));
  45. static XPVNV *more_xnv _((void));
  46. static XPV *more_xpv _((void));
  47. static XRV *more_xrv _((void));
  48. static SV *new_sv _((void));
  49. static XPVIV *new_xiv _((void));
  50. static XPVNV *new_xnv _((void));
  51. static XPV *new_xpv _((void));
  52. static XRV *new_xrv _((void));
  53. static void del_xiv _((XPVIV* p));
  54. static void del_xnv _((XPVNV* p));
  55. static void del_xpv _((XPV* p));
  56. static void del_xrv _((XRV* p));
  57. static void sv_mortalgrow _((void));
  58.  
  59. static void sv_unglob _((SV* sv));
  60.  
  61. #ifdef PURIFY
  62.  
  63. #define new_SV() sv = (SV*)safemalloc(sizeof(SV))
  64. #define del_SV(p) free((char*)p)
  65.  
  66. void
  67. sv_add_arena(ptr, size, flags)
  68. char* ptr;
  69. U32 size;
  70. U32 flags;
  71. {
  72.     if (!(flags & SVf_FAKE))
  73.     free(ptr);
  74. }
  75.  
  76. #else
  77.  
  78. #define new_SV()            \
  79.     if (sv_root) {            \
  80.     sv = sv_root;            \
  81.     sv_root = (SV*)SvANY(sv);    \
  82.     ++sv_count;            \
  83.     }                    \
  84.     else                \
  85.     sv = more_sv();
  86.  
  87. static SV*
  88. new_sv()
  89. {
  90.     SV* sv;
  91.     if (sv_root) {
  92.     sv = sv_root;
  93.     sv_root = (SV*)SvANY(sv);
  94.     ++sv_count;
  95.     return sv;
  96.     }
  97.     return more_sv();
  98. }
  99.  
  100. #ifdef DEBUGGING
  101. #define del_SV(p)            \
  102.     if (debug & 32768)            \
  103.     del_sv(p);            \
  104.     else {                \
  105.     SvANY(p) = (void *)sv_root;    \
  106.     sv_root = p;            \
  107.     --sv_count;            \
  108.     }
  109.  
  110. static void
  111. del_sv(p)
  112. SV* p;
  113. {
  114.     if (debug & 32768) {
  115.     SV* sva;
  116.     SV* sv;
  117.     SV* svend;
  118.     int ok = 0;
  119.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  120.         sv = sva + 1;
  121.         svend = &sva[SvREFCNT(sva)];
  122.         if (p >= sv && p < svend)
  123.         ok = 1;
  124.     }
  125.     if (!ok) {
  126.         warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
  127.         return;
  128.     }
  129.     }
  130.     SvANY(p) = (void *) sv_root;
  131.     sv_root = p;
  132.     --sv_count;
  133. }
  134. #else
  135. #define del_SV(p)            \
  136.     SvANY(p) = (void *)sv_root;        \
  137.     sv_root = p;            \
  138.     --sv_count;
  139.  
  140. #endif
  141.  
  142. void
  143. sv_add_arena(ptr, size, flags)
  144. char* ptr;
  145. U32 size;
  146. U32 flags;
  147. {
  148.     SV* sva = (SV*)ptr;
  149.     register SV* sv;
  150.     register SV* svend;
  151.     Zero(sva, size, char);
  152.  
  153.     /* The first SV in an arena isn't an SV. */
  154.     SvANY(sva) = (void *) sv_arenaroot;        /* ptr to next arena */
  155.     SvREFCNT(sva) = size / sizeof(SV);        /* number of SV slots */
  156.     SvFLAGS(sva) = flags;            /* FAKE if not to be freed */
  157.  
  158.     sv_arenaroot = sva;
  159.     sv_root = sva + 1;
  160.  
  161.     svend = &sva[SvREFCNT(sva) - 1];
  162.     sv = sva + 1;
  163.     while (sv < svend) {
  164.     SvANY(sv) = (void *)(SV*)(sv + 1);
  165.     SvFLAGS(sv) = SVTYPEMASK;
  166.     sv++;
  167.     }
  168.     SvANY(sv) = 0;
  169.     SvFLAGS(sv) = SVTYPEMASK;
  170. }
  171.  
  172. static SV*
  173. more_sv()
  174. {
  175.     if (nice_chunk) {
  176.     sv_add_arena(nice_chunk, nice_chunk_size, 0);
  177.     nice_chunk = Nullch;
  178.     }
  179.     else
  180.     sv_add_arena(safemalloc(1008), 1008, 0);
  181.     return new_sv();
  182. }
  183. #endif
  184.  
  185. void
  186. sv_report_used()
  187. {
  188.     SV* sva;
  189.     SV* sv;
  190.     register SV* svend;
  191.  
  192.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  193.     sv = sva + 1;
  194.     svend = &sva[SvREFCNT(sva)];
  195.     while (sv < svend) {
  196.         if (SvTYPE(sv) != SVTYPEMASK) {
  197.         fprintf(stderr, "****\n");
  198.         sv_dump(sv);
  199.         }
  200.         ++sv;
  201.     }
  202.     }
  203. }
  204.  
  205. void
  206. sv_clean_objs()
  207. {
  208.     SV* sva;
  209.     register SV* sv;
  210.     register SV* svend;
  211.     SV* rv;
  212.  
  213. #ifndef DISABLE_DESTRUCTOR_KLUDGE
  214.     register GV* gv;
  215.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  216.     gv = sva + 1;
  217.     svend = &sva[SvREFCNT(sva)];
  218.     while (gv < svend) {
  219.         if (SvTYPE(gv) == SVt_PVGV && (sv = GvSV(gv)) &&
  220.         SvROK(sv) && SvOBJECT(rv = SvRV(sv)))
  221.         {
  222.         DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
  223.              sv_dump(sv));)
  224.         SvROK_off(sv);
  225.         SvRV(sv) = 0;
  226.         SvREFCNT_dec(rv);
  227.         }
  228.         ++gv;
  229.     }
  230.     }
  231.     if (!sv_objcount)
  232.     return;
  233. #endif
  234.     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
  235.     sv = sva + 1;
  236.     svend = &sva[SvREFCNT(sva)];
  237.     while (sv < svend) {
  238.         if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
  239.         DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
  240.              sv_dump(sv));)
  241.         SvROK_off(sv);
  242.         SvRV(sv) = 0;
  243.         SvREFCNT_dec(rv);
  244.         }
  245.         /* XXX Might want to check arrays, etc. */
  246.         ++sv;
  247.     }
  248.     }
  249. }
  250.  
  251. void
  252. sv_clean_all()
  253. {
  254.     SV* sva;
  255.     register SV* sv;
  256.     register SV* svend;
  257.  
  258.     for (sva = sv_arenaroot; sva; sva = (SV*) SvANY(sva)) {
  259.     sv = sva + 1;
  260.     svend = &sva[SvREFCNT(sva)];
  261.     while (sv < svend) {
  262.         if (SvTYPE(sv) != SVTYPEMASK) {
  263.         DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
  264.         SvFLAGS(sv) |= SVf_BREAK;
  265.         SvREFCNT_dec(sv);
  266.         }
  267.         ++sv;
  268.     }
  269.     }
  270. }
  271.  
  272. void
  273. sv_free_arenas()
  274. {
  275.     SV* sva;
  276.     SV* svanext;
  277.  
  278.     /* Free arenas here, but be careful about fake ones.  (We assume
  279.        contiguity of the fake ones with the corresponding real ones.) */
  280.  
  281.     for (sva = sv_arenaroot; sva; sva = svanext) {
  282.     svanext = (SV*) SvANY(sva);
  283.     while (svanext && SvFAKE(svanext))
  284.         svanext = (SV*) SvANY(svanext);
  285.  
  286.     if (!SvFAKE(sva))
  287.         Safefree(sva);
  288.     }
  289. }
  290.  
  291. static XPVIV*
  292. new_xiv()
  293. {
  294.     IV** xiv;
  295.     if (xiv_root) {
  296.     xiv = xiv_root;
  297.     /*
  298.      * See comment in more_xiv() -- RAM.
  299.      */
  300.     xiv_root = (IV**)*xiv;
  301.     return (XPVIV*)((char*)xiv - sizeof(XPV));
  302.     }
  303.     return more_xiv();
  304. }
  305.  
  306. static void
  307. del_xiv(p)
  308. XPVIV* p;
  309. {
  310.     IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
  311.     *xiv = (IV *)xiv_root;
  312.     xiv_root = xiv;
  313. }
  314.  
  315. static XPVIV*
  316. more_xiv()
  317. {
  318.     register IV** xiv;
  319.     register IV** xivend;
  320.     XPV* ptr = (XPV*)safemalloc(1008);
  321.     ptr->xpv_pv = (char*)xiv_arenaroot;        /* linked list of xiv arenas */
  322.     xiv_arenaroot = ptr;            /* to keep Purify happy */
  323.  
  324.     xiv = (IV**) ptr;
  325.     xivend = &xiv[1008 / sizeof(IV *) - 1];
  326.     xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
  327.     xiv_root = xiv;
  328.     while (xiv < xivend) {
  329.     *xiv = (IV *)(xiv + 1);
  330.     xiv++;
  331.     }
  332.     *xiv = 0;
  333.     return new_xiv();
  334. }
  335.  
  336. static XPVNV*
  337. new_xnv()
  338. {
  339.     double* xnv;
  340.     if (xnv_root) {
  341.     xnv = xnv_root;
  342.     xnv_root = *(double**)xnv;
  343.     return (XPVNV*)((char*)xnv - sizeof(XPVIV));
  344.     }
  345.     return more_xnv();
  346. }
  347.  
  348. static void
  349. del_xnv(p)
  350. XPVNV* p;
  351. {
  352.     double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
  353.     *(double**)xnv = xnv_root;
  354.     xnv_root = xnv;
  355. }
  356.  
  357. static XPVNV*
  358. more_xnv()
  359. {
  360.     register double* xnv;
  361.     register double* xnvend;
  362.     xnv = (double*)safemalloc(1008);
  363.     xnvend = &xnv[1008 / sizeof(double) - 1];
  364.     xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
  365.     xnv_root = xnv;
  366.     while (xnv < xnvend) {
  367.     *(double**)xnv = (double*)(xnv + 1);
  368.     xnv++;
  369.     }
  370.     *(double**)xnv = 0;
  371.     return new_xnv();
  372. }
  373.  
  374. static XRV*
  375. new_xrv()
  376. {
  377.     XRV* xrv;
  378.     if (xrv_root) {
  379.     xrv = xrv_root;
  380.     xrv_root = (XRV*)xrv->xrv_rv;
  381.     return xrv;
  382.     }
  383.     return more_xrv();
  384. }
  385.  
  386. static void
  387. del_xrv(p)
  388. XRV* p;
  389. {
  390.     p->xrv_rv = (SV*)xrv_root;
  391.     xrv_root = p;
  392. }
  393.  
  394. static XRV*
  395. more_xrv()
  396. {
  397.     register XRV* xrv;
  398.     register XRV* xrvend;
  399.     xrv_root = (XRV*)safemalloc(1008);
  400.     xrv = xrv_root;
  401.     xrvend = &xrv[1008 / sizeof(XRV) - 1];
  402.     while (xrv < xrvend) {
  403.     xrv->xrv_rv = (SV*)(xrv + 1);
  404.     xrv++;
  405.     }
  406.     xrv->xrv_rv = 0;
  407.     return new_xrv();
  408. }
  409.  
  410. static XPV*
  411. new_xpv()
  412. {
  413.     XPV* xpv;
  414.     if (xpv_root) {
  415.     xpv = xpv_root;
  416.     xpv_root = (XPV*)xpv->xpv_pv;
  417.     return xpv;
  418.     }
  419.     return more_xpv();
  420. }
  421.  
  422. static void
  423. del_xpv(p)
  424. XPV* p;
  425. {
  426.     p->xpv_pv = (char*)xpv_root;
  427.     xpv_root = p;
  428. }
  429.  
  430. static XPV*
  431. more_xpv()
  432. {
  433.     register XPV* xpv;
  434.     register XPV* xpvend;
  435.     xpv_root = (XPV*)safemalloc(1008);
  436.     xpv = xpv_root;
  437.     xpvend = &xpv[1008 / sizeof(XPV) - 1];
  438.     while (xpv < xpvend) {
  439.     xpv->xpv_pv = (char*)(xpv + 1);
  440.     xpv++;
  441.     }
  442.     xpv->xpv_pv = 0;
  443.     return new_xpv();
  444. }
  445.  
  446. #ifdef PURIFY
  447. #define new_XIV() (void*)safemalloc(sizeof(XPVIV))
  448. #define del_XIV(p) free((char*)p)
  449. #else
  450. #define new_XIV() (void*)new_xiv()
  451. #define del_XIV(p) del_xiv(p)
  452. #endif
  453.  
  454. #ifdef PURIFY
  455. #define new_XNV() (void*)safemalloc(sizeof(XPVNV))
  456. #define del_XNV(p) free((char*)p)
  457. #else
  458. #define new_XNV() (void*)new_xnv()
  459. #define del_XNV(p) del_xnv(p)
  460. #endif
  461.  
  462. #ifdef PURIFY
  463. #define new_XRV() (void*)safemalloc(sizeof(XRV))
  464. #define del_XRV(p) free((char*)p)
  465. #else
  466. #define new_XRV() (void*)new_xrv()
  467. #define del_XRV(p) del_xrv(p)
  468. #endif
  469.  
  470. #ifdef PURIFY
  471. #define new_XPV() (void*)safemalloc(sizeof(XPV))
  472. #define del_XPV(p) free((char*)p)
  473. #else
  474. #define new_XPV() (void*)new_xpv()
  475. #define del_XPV(p) del_xpv(p)
  476. #endif
  477.  
  478. #define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
  479. #define del_XPVIV(p) free((char*)p)
  480.  
  481. #define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
  482. #define del_XPVNV(p) free((char*)p)
  483.  
  484. #define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
  485. #define del_XPVMG(p) free((char*)p)
  486.  
  487. #define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
  488. #define del_XPVLV(p) free((char*)p)
  489.  
  490. #define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
  491. #define del_XPVAV(p) free((char*)p)
  492.  
  493. #define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
  494. #define del_XPVHV(p) free((char*)p)
  495.  
  496. #define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
  497. #define del_XPVCV(p) free((char*)p)
  498.  
  499. #define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
  500. #define del_XPVGV(p) free((char*)p)
  501.  
  502. #define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
  503. #define del_XPVBM(p) free((char*)p)
  504.  
  505. #define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
  506. #define del_XPVFM(p) free((char*)p)
  507.  
  508. #define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
  509. #define del_XPVIO(p) free((char*)p)
  510.  
  511. bool
  512. sv_upgrade(sv, mt)
  513. register SV* sv;
  514. U32 mt;
  515. {
  516.     char*    pv;
  517.     U32        cur;
  518.     U32        len;
  519.     IV        iv;
  520.     double    nv;
  521.     MAGIC*    magic;
  522.     HV*        stash;
  523.  
  524.     if (SvTYPE(sv) == mt)
  525.     return TRUE;
  526.  
  527.     if (mt < SVt_PVIV)
  528.     (void)SvOOK_off(sv);
  529.  
  530.     switch (SvTYPE(sv)) {
  531.     case SVt_NULL:
  532.     pv    = 0;
  533.     cur    = 0;
  534.     len    = 0;
  535.     iv    = 0;
  536.     nv    = 0.0;
  537.     magic    = 0;
  538.     stash    = 0;
  539.     break;
  540.     case SVt_IV:
  541.     pv    = 0;
  542.     cur    = 0;
  543.     len    = 0;
  544.     iv    = SvIVX(sv);
  545.     nv    = (double)SvIVX(sv);
  546.     del_XIV(SvANY(sv));
  547.     magic    = 0;
  548.     stash    = 0;
  549.     if (mt == SVt_NV)
  550.         mt = SVt_PVNV;
  551.     else if (mt < SVt_PVIV)
  552.         mt = SVt_PVIV;
  553.     break;
  554.     case SVt_NV:
  555.     pv    = 0;
  556.     cur    = 0;
  557.     len    = 0;
  558.     nv    = SvNVX(sv);
  559.     iv    = I_32(nv);
  560.     magic    = 0;
  561.     stash    = 0;
  562.     del_XNV(SvANY(sv));
  563.     SvANY(sv) = 0;
  564.     if (mt < SVt_PVNV)
  565.         mt = SVt_PVNV;
  566.     break;
  567.     case SVt_RV:
  568.     pv    = (char*)SvRV(sv);
  569.     cur    = 0;
  570.     len    = 0;
  571.     iv    = (IV)pv;
  572.     nv    = (double)(unsigned long)pv;
  573.     del_XRV(SvANY(sv));
  574.     magic    = 0;
  575.     stash    = 0;
  576.     break;
  577.     case SVt_PV:
  578.     nv = 0.0;
  579.     pv    = SvPVX(sv);
  580.     cur    = SvCUR(sv);
  581.     len    = SvLEN(sv);
  582.     iv    = 0;
  583.     nv    = 0.0;
  584.     magic    = 0;
  585.     stash    = 0;
  586.     del_XPV(SvANY(sv));
  587.     if (mt <= SVt_IV)
  588.         mt = SVt_PVIV;
  589.     else if (mt == SVt_NV)
  590.         mt = SVt_PVNV;
  591.     break;
  592.     case SVt_PVIV:
  593.     nv = 0.0;
  594.     pv    = SvPVX(sv);
  595.     cur    = SvCUR(sv);
  596.     len    = SvLEN(sv);
  597.     iv    = SvIVX(sv);
  598.     nv    = 0.0;
  599.     magic    = 0;
  600.     stash    = 0;
  601.     del_XPVIV(SvANY(sv));
  602.     break;
  603.     case SVt_PVNV:
  604.     nv = SvNVX(sv);
  605.     pv    = SvPVX(sv);
  606.     cur    = SvCUR(sv);
  607.     len    = SvLEN(sv);
  608.     iv    = SvIVX(sv);
  609.     nv    = SvNVX(sv);
  610.     magic    = 0;
  611.     stash    = 0;
  612.     del_XPVNV(SvANY(sv));
  613.     break;
  614.     case SVt_PVMG:
  615.     pv    = SvPVX(sv);
  616.     cur    = SvCUR(sv);
  617.     len    = SvLEN(sv);
  618.     iv    = SvIVX(sv);
  619.     nv    = SvNVX(sv);
  620.     magic    = SvMAGIC(sv);
  621.     stash    = SvSTASH(sv);
  622.     del_XPVMG(SvANY(sv));
  623.     break;
  624.     default:
  625.     croak("Can't upgrade that kind of scalar");
  626.     }
  627.  
  628.     switch (mt) {
  629.     case SVt_NULL:
  630.     croak("Can't upgrade to undef");
  631.     case SVt_IV:
  632.     SvANY(sv) = new_XIV();
  633.     SvIVX(sv)    = iv;
  634.     break;
  635.     case SVt_NV:
  636.     SvANY(sv) = new_XNV();
  637.     SvNVX(sv)    = nv;
  638.     break;
  639.     case SVt_RV:
  640.     SvANY(sv) = new_XRV();
  641.     SvRV(sv) = (SV*)pv;
  642.     break;
  643.     case SVt_PV:
  644.     SvANY(sv) = new_XPV();
  645.     SvPVX(sv)    = pv;
  646.     SvCUR(sv)    = cur;
  647.     SvLEN(sv)    = len;
  648.     break;
  649.     case SVt_PVIV:
  650.     SvANY(sv) = new_XPVIV();
  651.     SvPVX(sv)    = pv;
  652.     SvCUR(sv)    = cur;
  653.     SvLEN(sv)    = len;
  654.     SvIVX(sv)    = iv;
  655.     if (SvNIOK(sv))
  656.         (void)SvIOK_on(sv);
  657.     SvNOK_off(sv);
  658.     break;
  659.     case SVt_PVNV:
  660.     SvANY(sv) = new_XPVNV();
  661.     SvPVX(sv)    = pv;
  662.     SvCUR(sv)    = cur;
  663.     SvLEN(sv)    = len;
  664.     SvIVX(sv)    = iv;
  665.     SvNVX(sv)    = nv;
  666.     break;
  667.     case SVt_PVMG:
  668.     SvANY(sv) = new_XPVMG();
  669.     SvPVX(sv)    = pv;
  670.     SvCUR(sv)    = cur;
  671.     SvLEN(sv)    = len;
  672.     SvIVX(sv)    = iv;
  673.     SvNVX(sv)    = nv;
  674.     SvMAGIC(sv)    = magic;
  675.     SvSTASH(sv)    = stash;
  676.     break;
  677.     case SVt_PVLV:
  678.     SvANY(sv) = new_XPVLV();
  679.     SvPVX(sv)    = pv;
  680.     SvCUR(sv)    = cur;
  681.     SvLEN(sv)    = len;
  682.     SvIVX(sv)    = iv;
  683.     SvNVX(sv)    = nv;
  684.     SvMAGIC(sv)    = magic;
  685.     SvSTASH(sv)    = stash;
  686.     LvTARGOFF(sv)    = 0;
  687.     LvTARGLEN(sv)    = 0;
  688.     LvTARG(sv)    = 0;
  689.     LvTYPE(sv)    = 0;
  690.     break;
  691.     case SVt_PVAV:
  692.     SvANY(sv) = new_XPVAV();
  693.     if (pv)
  694.         Safefree(pv);
  695.     SvPVX(sv)    = 0;
  696.     AvMAX(sv)    = 0;
  697.     AvFILL(sv)    = 0;
  698.     SvIVX(sv)    = 0;
  699.     SvNVX(sv)    = 0.0;
  700.     SvMAGIC(sv)    = magic;
  701.     SvSTASH(sv)    = stash;
  702.     AvALLOC(sv)    = 0;
  703.     AvARYLEN(sv)    = 0;
  704.     AvFLAGS(sv)    = 0;
  705.     break;
  706.     case SVt_PVHV:
  707.     SvANY(sv) = new_XPVHV();
  708.     if (pv)
  709.         Safefree(pv);
  710.     SvPVX(sv)    = 0;
  711.     HvFILL(sv)    = 0;
  712.     HvMAX(sv)    = 0;
  713.     HvKEYS(sv)    = 0;
  714.     SvNVX(sv)    = 0.0;
  715.     SvMAGIC(sv)    = magic;
  716.     SvSTASH(sv)    = stash;
  717.     HvRITER(sv)    = 0;
  718.     HvEITER(sv)    = 0;
  719.     HvPMROOT(sv)    = 0;
  720.     HvNAME(sv)    = 0;
  721.     break;
  722.     case SVt_PVCV:
  723.     SvANY(sv) = new_XPVCV();
  724.     Zero(SvANY(sv), 1, XPVCV);
  725.     SvPVX(sv)    = pv;
  726.     SvCUR(sv)    = cur;
  727.     SvLEN(sv)    = len;
  728.     SvIVX(sv)    = iv;
  729.     SvNVX(sv)    = nv;
  730.     SvMAGIC(sv)    = magic;
  731.     SvSTASH(sv)    = stash;
  732.     break;
  733.     case SVt_PVGV:
  734.     SvANY(sv) = new_XPVGV();
  735.     SvPVX(sv)    = pv;
  736.     SvCUR(sv)    = cur;
  737.     SvLEN(sv)    = len;
  738.     SvIVX(sv)    = iv;
  739.     SvNVX(sv)    = nv;
  740.     SvMAGIC(sv)    = magic;
  741.     SvSTASH(sv)    = stash;
  742.     GvGP(sv)    = 0;
  743.     GvNAME(sv)    = 0;
  744.     GvNAMELEN(sv)    = 0;
  745.     GvSTASH(sv)    = 0;
  746.     GvFLAGS(sv)    = 0;
  747.     break;
  748.     case SVt_PVBM:
  749.     SvANY(sv) = new_XPVBM();
  750.     SvPVX(sv)    = pv;
  751.     SvCUR(sv)    = cur;
  752.     SvLEN(sv)    = len;
  753.     SvIVX(sv)    = iv;
  754.     SvNVX(sv)    = nv;
  755.     SvMAGIC(sv)    = magic;
  756.     SvSTASH(sv)    = stash;
  757.     BmRARE(sv)    = 0;
  758.     BmUSEFUL(sv)    = 0;
  759.     BmPREVIOUS(sv)    = 0;
  760.     break;
  761.     case SVt_PVFM:
  762.     SvANY(sv) = new_XPVFM();
  763.     Zero(SvANY(sv), 1, XPVFM);
  764.     SvPVX(sv)    = pv;
  765.     SvCUR(sv)    = cur;
  766.     SvLEN(sv)    = len;
  767.     SvIVX(sv)    = iv;
  768.     SvNVX(sv)    = nv;
  769.     SvMAGIC(sv)    = magic;
  770.     SvSTASH(sv)    = stash;
  771.     break;
  772.     case SVt_PVIO:
  773.     SvANY(sv) = new_XPVIO();
  774.     Zero(SvANY(sv), 1, XPVIO);
  775.     SvPVX(sv)    = pv;
  776.     SvCUR(sv)    = cur;
  777.     SvLEN(sv)    = len;
  778.     SvIVX(sv)    = iv;
  779.     SvNVX(sv)    = nv;
  780.     SvMAGIC(sv)    = magic;
  781.     SvSTASH(sv)    = stash;
  782.     IoPAGE_LEN(sv)    = 60;
  783.     break;
  784.     }
  785.     SvFLAGS(sv) &= ~SVTYPEMASK;
  786.     SvFLAGS(sv) |= mt;
  787.     return TRUE;
  788. }
  789.  
  790. #ifdef DEBUGGING
  791. char *
  792. sv_peek(sv)
  793. register SV *sv;
  794. {
  795.     char *t = tokenbuf;
  796.     int unref = 0;
  797.  
  798.   retry:
  799.     if (!sv) {
  800.     strcpy(t, "VOID");
  801.     goto finish;
  802.     }
  803.     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
  804.     strcpy(t, "WILD");
  805.     goto finish;
  806.     }
  807.     else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
  808.     if (sv == &sv_undef) {
  809.         strcpy(t, "SV_UNDEF");
  810.         if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
  811.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  812.         SvREADONLY(sv))
  813.         goto finish;
  814.     }
  815.     else if (sv == &sv_no) {
  816.         strcpy(t, "SV_NO");
  817.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  818.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  819.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  820.                   SVp_POK|SVp_NOK)) &&
  821.         SvCUR(sv) == 0 &&
  822.         SvNVX(sv) == 0.0)
  823.         goto finish;
  824.     }
  825.     else {
  826.         strcpy(t, "SV_YES");
  827.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  828.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  829.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  830.                   SVp_POK|SVp_NOK)) &&
  831.         SvCUR(sv) == 1 &&
  832.         SvPVX(sv) && *SvPVX(sv) == '1' &&
  833.         SvNVX(sv) == 1.0)
  834.         goto finish;
  835.     }
  836.     t += strlen(t);
  837.     *t++ = ':';
  838.     }
  839.     else if (SvREFCNT(sv) == 0) {
  840.     *t++ = '(';
  841.     unref++;
  842.     }
  843.     if (SvROK(sv)) {
  844.     *t++ = '\\';
  845.     if (t - tokenbuf + unref > 10) {
  846.         strcpy(tokenbuf + unref + 3,"...");
  847.         goto finish;
  848.     }
  849.     sv = (SV*)SvRV(sv);
  850.     goto retry;
  851.     }
  852.     switch (SvTYPE(sv)) {
  853.     default:
  854.     strcpy(t,"FREED");
  855.     goto finish;
  856.  
  857.     case SVt_NULL:
  858.     strcpy(t,"UNDEF");
  859.     return tokenbuf;
  860.     case SVt_IV:
  861.     strcpy(t,"IV");
  862.     break;
  863.     case SVt_NV:
  864.     strcpy(t,"NV");
  865.     break;
  866.     case SVt_RV:
  867.     strcpy(t,"RV");
  868.     break;
  869.     case SVt_PV:
  870.     strcpy(t,"PV");
  871.     break;
  872.     case SVt_PVIV:
  873.     strcpy(t,"PVIV");
  874.     break;
  875.     case SVt_PVNV:
  876.     strcpy(t,"PVNV");
  877.     break;
  878.     case SVt_PVMG:
  879.     strcpy(t,"PVMG");
  880.     break;
  881.     case SVt_PVLV:
  882.     strcpy(t,"PVLV");
  883.     break;
  884.     case SVt_PVAV:
  885.     strcpy(t,"AV");
  886.     break;
  887.     case SVt_PVHV:
  888.     strcpy(t,"HV");
  889.     break;
  890.     case SVt_PVCV:
  891.     if (CvGV(sv))
  892.         sprintf(t, "CV(%s)", GvNAME(CvGV(sv)));
  893.     else
  894.         strcpy(t, "CV()");
  895.     goto finish;
  896.     case SVt_PVGV:
  897.     strcpy(t,"GV");
  898.     break;
  899.     case SVt_PVBM:
  900.     strcpy(t,"BM");
  901.     break;
  902.     case SVt_PVFM:
  903.     strcpy(t,"FM");
  904.     break;
  905.     case SVt_PVIO:
  906.     strcpy(t,"IO");
  907.     break;
  908.     }
  909.     t += strlen(t);
  910.  
  911.     if (SvPOKp(sv)) {
  912.     if (!SvPVX(sv))
  913.         strcpy(t, "(null)");
  914.     if (SvOOK(sv))
  915.         sprintf(t,"(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv));
  916.     else
  917.         sprintf(t,"(\"%.127s\")",SvPVX(sv));
  918.     }
  919.     else if (SvNOKp(sv))
  920.     sprintf(t,"(%g)",SvNVX(sv));
  921.     else if (SvIOKp(sv))
  922.     sprintf(t,"(%ld)",(long)SvIVX(sv));
  923.     else
  924.     strcpy(t,"()");
  925.     
  926.   finish:
  927.     if (unref) {
  928.     t += strlen(t);
  929.     while (unref--)
  930.         *t++ = ')';
  931.     *t = '\0';
  932.     }
  933.     return tokenbuf;
  934. }
  935. #endif
  936.  
  937. int
  938. sv_backoff(sv)
  939. register SV *sv;
  940. {
  941.     assert(SvOOK(sv));
  942.     if (SvIVX(sv)) {
  943.     char *s = SvPVX(sv);
  944.     SvLEN(sv) += SvIVX(sv);
  945.     SvPVX(sv) -= SvIVX(sv);
  946.     SvIV_set(sv, 0);
  947.     Move(s, SvPVX(sv), SvCUR(sv)+1, char);
  948.     }
  949.     SvFLAGS(sv) &= ~SVf_OOK;
  950.     return 0;
  951. }
  952.  
  953. char *
  954. sv_grow(sv,newlen)
  955. register SV *sv;
  956. #ifndef DOSISH
  957. register I32 newlen;
  958. #else
  959. unsigned long newlen;
  960. #endif
  961. {
  962.     register char *s;
  963.  
  964. #ifdef MSDOS
  965.     if (newlen >= 0x10000) {
  966.     fprintf(stderr, "Allocation too large: %lx\n", newlen);
  967.     my_exit(1);
  968.     }
  969. #endif /* MSDOS */
  970.     if (SvROK(sv))
  971.     sv_unref(sv);
  972.     if (SvTYPE(sv) < SVt_PV) {
  973.     sv_upgrade(sv, SVt_PV);
  974.     s = SvPVX(sv);
  975.     }
  976.     else if (SvOOK(sv)) {    /* pv is offset? */
  977.     sv_backoff(sv);
  978.     s = SvPVX(sv);
  979.     if (newlen > SvLEN(sv))
  980.         newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
  981.     }
  982.     else
  983.     s = SvPVX(sv);
  984.     if (newlen > SvLEN(sv)) {        /* need more room? */
  985.         if (SvLEN(sv) && s)
  986.         Renew(s,newlen,char);
  987.         else
  988.         New(703,s,newlen,char);
  989.     SvPV_set(sv, s);
  990.         SvLEN_set(sv, newlen);
  991.     }
  992.     return s;
  993. }
  994.  
  995. void
  996. sv_setiv(sv,i)
  997. register SV *sv;
  998. IV i;
  999. {
  1000.     if (SvTHINKFIRST(sv)) {
  1001.     if (SvREADONLY(sv) && curcop != &compiling)
  1002.         croak(no_modify);
  1003.     if (SvROK(sv))
  1004.         sv_unref(sv);
  1005.     }
  1006.     switch (SvTYPE(sv)) {
  1007.     case SVt_NULL:
  1008.     sv_upgrade(sv, SVt_IV);
  1009.     break;
  1010.     case SVt_NV:
  1011.     sv_upgrade(sv, SVt_PVNV);
  1012.     break;
  1013.     case SVt_RV:
  1014.     case SVt_PV:
  1015.     sv_upgrade(sv, SVt_PVIV);
  1016.     break;
  1017.  
  1018.     case SVt_PVGV:
  1019.     if (SvFAKE(sv)) {
  1020.         sv_unglob(sv);
  1021.         break;
  1022.     }
  1023.     /* FALL THROUGH */
  1024.     case SVt_PVAV:
  1025.     case SVt_PVHV:
  1026.     case SVt_PVCV:
  1027.     case SVt_PVFM:
  1028.     case SVt_PVIO:
  1029.     croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
  1030.         op_name[op->op_type]);
  1031.     }
  1032.     (void)SvIOK_only(sv);            /* validate number */
  1033.     SvIVX(sv) = i;
  1034.     SvTAINT(sv);
  1035. }
  1036.  
  1037. void
  1038. sv_setnv(sv,num)
  1039. register SV *sv;
  1040. double num;
  1041. {
  1042.     if (SvTHINKFIRST(sv)) {
  1043.     if (SvREADONLY(sv) && curcop != &compiling)
  1044.         croak(no_modify);
  1045.     if (SvROK(sv))
  1046.         sv_unref(sv);
  1047.     }
  1048.     switch (SvTYPE(sv)) {
  1049.     case SVt_NULL:
  1050.     case SVt_IV:
  1051.     sv_upgrade(sv, SVt_NV);
  1052.     break;
  1053.     case SVt_NV:
  1054.     case SVt_RV:
  1055.     case SVt_PV:
  1056.     case SVt_PVIV:
  1057.     sv_upgrade(sv, SVt_PVNV);
  1058.     /* FALL THROUGH */
  1059.     case SVt_PVNV:
  1060.     case SVt_PVMG:
  1061.     case SVt_PVBM:
  1062.     case SVt_PVLV:
  1063.     if (SvOOK(sv))
  1064.         (void)SvOOK_off(sv);
  1065.     break;
  1066.     case SVt_PVGV:
  1067.     if (SvFAKE(sv)) {
  1068.         sv_unglob(sv);
  1069.         break;
  1070.     }
  1071.     /* FALL THROUGH */
  1072.     case SVt_PVAV:
  1073.     case SVt_PVHV:
  1074.     case SVt_PVCV:
  1075.     case SVt_PVFM:
  1076.     case SVt_PVIO:
  1077.     croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
  1078.         op_name[op->op_type]);
  1079.     }
  1080.     SvNVX(sv) = num;
  1081.     (void)SvNOK_only(sv);            /* validate number */
  1082.     SvTAINT(sv);
  1083. }
  1084.  
  1085. static void
  1086. not_a_number(sv)
  1087. SV *sv;
  1088. {
  1089.     char tmpbuf[64];
  1090.     char *d = tmpbuf;
  1091.     char *s;
  1092.     int i;
  1093.  
  1094.     for (s = SvPVX(sv), i = 50; *s && i; s++,i--) {
  1095.     int ch = *s;
  1096.     if (ch & 128 && !isprint(ch)) {
  1097.         *d++ = 'M';
  1098.         *d++ = '-';
  1099.         ch &= 127;
  1100.     }
  1101.     if (isprint(ch))
  1102.         *d++ = ch;
  1103.     else {
  1104.         *d++ = '^';
  1105.         *d++ = ch ^ 64;
  1106.     }
  1107.     }
  1108.     if (*s) {
  1109.     *d++ = '.';
  1110.     *d++ = '.';
  1111.     *d++ = '.';
  1112.     }
  1113.     *d = '\0';
  1114.  
  1115.     if (op)
  1116.     warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
  1117.         op_name[op->op_type]);
  1118.     else
  1119.     warn("Argument \"%s\" isn't numeric", tmpbuf);
  1120. }
  1121.  
  1122. IV
  1123. sv_2iv(sv)
  1124. register SV *sv;
  1125. {
  1126.     if (!sv)
  1127.     return 0;
  1128.     if (SvGMAGICAL(sv)) {
  1129.     mg_get(sv);
  1130.     if (SvIOKp(sv))
  1131.         return SvIVX(sv);
  1132.     if (SvNOKp(sv)) {
  1133.         if (SvNVX(sv) < 0.0)
  1134.         return I_V(SvNVX(sv));
  1135.         else
  1136.         return (IV) U_V(SvNVX(sv));
  1137.     }
  1138.     if (SvPOKp(sv) && SvLEN(sv)) {
  1139.         if (dowarn && !looks_like_number(sv))
  1140.         not_a_number(sv);
  1141.         return (IV)atol(SvPVX(sv));
  1142.     }
  1143.         if (!SvROK(sv)) {
  1144.             return 0;
  1145.         }
  1146.     }
  1147.     if (SvTHINKFIRST(sv)) {
  1148.     if (SvROK(sv)) {
  1149. #ifdef OVERLOAD
  1150.       SV* tmpstr;
  1151.       if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
  1152.         return SvIV(tmpstr);
  1153. #endif /* OVERLOAD */
  1154.       return (IV)SvRV(sv);
  1155.     }
  1156.     if (SvREADONLY(sv)) {
  1157.         if (SvNOKp(sv)) {
  1158.         if (SvNVX(sv) < 0.0)
  1159.             return I_V(SvNVX(sv));
  1160.         else
  1161.             return (IV) U_V(SvNVX(sv));
  1162.         }
  1163.         if (SvPOKp(sv) && SvLEN(sv)) {
  1164.         if (dowarn && !looks_like_number(sv))
  1165.             not_a_number(sv);
  1166.         return (IV)atol(SvPVX(sv));
  1167.         }
  1168.         if (dowarn)
  1169.         warn(warn_uninit);
  1170.         return 0;
  1171.     }
  1172.     }
  1173.     switch (SvTYPE(sv)) {
  1174.     case SVt_NULL:
  1175.     sv_upgrade(sv, SVt_IV);
  1176.     return SvIVX(sv);
  1177.     case SVt_PV:
  1178.     sv_upgrade(sv, SVt_PVIV);
  1179.     break;
  1180.     case SVt_NV:
  1181.     sv_upgrade(sv, SVt_PVNV);
  1182.     break;
  1183.     }
  1184.     if (SvNOKp(sv)) {
  1185.     (void)SvIOK_on(sv);
  1186.     if (SvNVX(sv) < 0.0)
  1187.         SvIVX(sv) = I_V(SvNVX(sv));
  1188.     else
  1189.         SvIVX(sv) = (IV) U_V(SvNVX(sv));
  1190.     }
  1191.     else if (SvPOKp(sv) && SvLEN(sv)) {
  1192.     if (dowarn && !looks_like_number(sv))
  1193.         not_a_number(sv);
  1194.     (void)SvIOK_on(sv);
  1195.     SvIVX(sv) = (IV)atol(SvPVX(sv));
  1196.     }
  1197.     else  {
  1198.     if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
  1199.         warn(warn_uninit);
  1200.     return 0;
  1201.     }
  1202.     DEBUG_c(fprintf(stderr,"0x%lx 2iv(%ld)\n",
  1203.     (unsigned long)sv,(long)SvIVX(sv)));
  1204.     return SvIVX(sv);
  1205. }
  1206.  
  1207. double
  1208. sv_2nv(sv)
  1209. register SV *sv;
  1210. {
  1211.     if (!sv)
  1212.     return 0.0;
  1213.     if (SvGMAGICAL(sv)) {
  1214.     mg_get(sv);
  1215.     if (SvNOKp(sv))
  1216.         return SvNVX(sv);
  1217.     if (SvPOKp(sv) && SvLEN(sv)) {
  1218.         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1219.         not_a_number(sv);
  1220.         return atof(SvPVX(sv));
  1221.     }
  1222.     if (SvIOKp(sv))
  1223.         return (double)SvIVX(sv);
  1224.         if (!SvROK(sv)) {
  1225.             return 0;
  1226.         }
  1227.     }
  1228.     if (SvTHINKFIRST(sv)) {
  1229.     if (SvROK(sv)) {
  1230. #ifdef OVERLOAD
  1231.       SV* tmpstr;
  1232.       if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
  1233.         return SvNV(tmpstr);
  1234. #endif /* OVERLOAD */
  1235.       return (double)(unsigned long)SvRV(sv);
  1236.     }
  1237.     if (SvREADONLY(sv)) {
  1238.         if (SvPOKp(sv) && SvLEN(sv)) {
  1239.         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1240.             not_a_number(sv);
  1241.         return atof(SvPVX(sv));
  1242.         }
  1243.         if (SvIOKp(sv))
  1244.         return (double)SvIVX(sv);
  1245.         if (dowarn)
  1246.         warn(warn_uninit);
  1247.         return 0.0;
  1248.     }
  1249.     }
  1250.     if (SvTYPE(sv) < SVt_NV) {
  1251.     if (SvTYPE(sv) == SVt_IV)
  1252.         sv_upgrade(sv, SVt_PVNV);
  1253.     else
  1254.         sv_upgrade(sv, SVt_NV);
  1255.     DEBUG_c(fprintf(stderr,"0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
  1256.     }
  1257.     else if (SvTYPE(sv) < SVt_PVNV)
  1258.     sv_upgrade(sv, SVt_PVNV);
  1259.     if (SvIOKp(sv) &&
  1260.         (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
  1261.     {
  1262.     SvNVX(sv) = (double)SvIVX(sv);
  1263.     }
  1264.     else if (SvPOKp(sv) && SvLEN(sv)) {
  1265.     if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1266.         not_a_number(sv);
  1267.     SvNVX(sv) = atof(SvPVX(sv));
  1268.     }
  1269.     else  {
  1270.     if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
  1271.         warn(warn_uninit);
  1272.     return 0.0;
  1273.     }
  1274.     SvNOK_on(sv);
  1275.     DEBUG_c(fprintf(stderr,"0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
  1276.     return SvNVX(sv);
  1277. }
  1278.  
  1279. char *
  1280. sv_2pv(sv, lp)
  1281. register SV *sv;
  1282. STRLEN *lp;
  1283. {
  1284.     register char *s;
  1285.     int olderrno;
  1286.  
  1287.     if (!sv) {
  1288.     *lp = 0;
  1289.     return "";
  1290.     }
  1291.     if (SvGMAGICAL(sv)) {
  1292.     mg_get(sv);
  1293.     if (SvPOKp(sv)) {
  1294.         *lp = SvCUR(sv);
  1295.         return SvPVX(sv);
  1296.     }
  1297.     if (SvIOKp(sv)) {
  1298.         (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
  1299.         goto tokensave;
  1300.     }
  1301.     if (SvNOKp(sv)) {
  1302.         Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
  1303.         goto tokensave;
  1304.     }
  1305.         if (!SvROK(sv)) {
  1306.             *lp = 0;
  1307.             return "";
  1308.         }
  1309.     }
  1310.     if (SvTHINKFIRST(sv)) {
  1311.     if (SvROK(sv)) {
  1312. #ifdef OVERLOAD
  1313.         SV* tmpstr;
  1314.         if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
  1315.           return SvPV(tmpstr,*lp);
  1316. #endif /* OVERLOAD */
  1317.         sv = (SV*)SvRV(sv);
  1318.         if (!sv)
  1319.         s = "NULLREF";
  1320.         else {
  1321.         switch (SvTYPE(sv)) {
  1322.         case SVt_NULL:
  1323.         case SVt_IV:
  1324.         case SVt_NV:
  1325.         case SVt_RV:
  1326.         case SVt_PV:
  1327.         case SVt_PVIV:
  1328.         case SVt_PVNV:
  1329.         case SVt_PVBM:
  1330.         case SVt_PVMG:    s = "SCALAR";            break;
  1331.         case SVt_PVLV:    s = "LVALUE";            break;
  1332.         case SVt_PVAV:    s = "ARRAY";            break;
  1333.         case SVt_PVHV:    s = "HASH";            break;
  1334.         case SVt_PVCV:    s = "CODE";            break;
  1335.         case SVt_PVGV:    s = "GLOB";            break;
  1336.         case SVt_PVFM:    s = "FORMATLINE";        break;
  1337.         case SVt_PVIO:    s = "FILEHANDLE";        break;
  1338.         default:    s = "UNKNOWN";            break;
  1339.         }
  1340.         if (SvOBJECT(sv))
  1341.             sprintf(tokenbuf, "%s=%s(0x%lx)",
  1342.                 HvNAME(SvSTASH(sv)), s, (unsigned long)sv);
  1343.         else
  1344.             sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv);
  1345.         goto tokensaveref;
  1346.         }
  1347.         *lp = strlen(s);
  1348.         return s;
  1349.     }
  1350.     if (SvREADONLY(sv)) {
  1351.         if (SvNOKp(sv)) {
  1352.         Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
  1353.         goto tokensave;
  1354.         }
  1355.         if (SvIOKp(sv)) {
  1356.         (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
  1357.         goto tokensave;
  1358.         }
  1359.         if (dowarn)
  1360.         warn(warn_uninit);
  1361.         *lp = 0;
  1362.         return "";
  1363.     }
  1364.     }
  1365.     if (!SvUPGRADE(sv, SVt_PV))
  1366.     return 0;
  1367.     if (SvNOKp(sv)) {
  1368.     if (SvTYPE(sv) < SVt_PVNV)
  1369.         sv_upgrade(sv, SVt_PVNV);
  1370.     SvGROW(sv, 28);
  1371.     s = SvPVX(sv);
  1372.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  1373. #ifdef apollo
  1374.     if (SvNVX(sv) == 0.0)
  1375.         (void)strcpy(s,"0");
  1376.     else
  1377. #endif /*apollo*/
  1378.         Gconvert(SvNVX(sv), DBL_DIG, 0, s);
  1379.     errno = olderrno;
  1380. #ifdef FIXNEGATIVEZERO
  1381.         if (*s == '-' && s[1] == '0' && !s[2])
  1382.         strcpy(s,"0");
  1383. #endif
  1384.     while (*s) s++;
  1385. #ifdef hcx
  1386.     if (s[-1] == '.')
  1387.         s--;
  1388. #endif
  1389.     }
  1390.     else if (SvIOKp(sv)) {
  1391.     if (SvTYPE(sv) < SVt_PVIV)
  1392.         sv_upgrade(sv, SVt_PVIV);
  1393.     SvGROW(sv, 11);
  1394.     s = SvPVX(sv);
  1395.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  1396.     (void)sprintf(s,"%ld",(long)SvIVX(sv));
  1397.     errno = olderrno;
  1398.     while (*s) s++;
  1399.     }
  1400.     else {
  1401.     if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
  1402.         warn(warn_uninit);
  1403.     *lp = 0;
  1404.     return "";
  1405.     }
  1406.     *s = '\0';
  1407.     *lp = s - SvPVX(sv);
  1408.     SvCUR_set(sv, *lp);
  1409.     SvPOK_on(sv);
  1410.     DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
  1411.     return SvPVX(sv);
  1412.  
  1413.   tokensave:
  1414.     if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
  1415.     /* Sneaky stuff here */
  1416.  
  1417.       tokensaveref:
  1418.     sv = sv_newmortal();
  1419.     *lp = strlen(tokenbuf);
  1420.     sv_setpvn(sv, tokenbuf, *lp);
  1421.     return SvPVX(sv);
  1422.     }
  1423.     else {
  1424.     STRLEN len;
  1425.     
  1426. #ifdef FIXNEGATIVEZERO
  1427.     if (*tokenbuf == '-' && tokenbuf[1] == '0' && !tokenbuf[2])
  1428.         strcpy(tokenbuf,"0");
  1429. #endif
  1430.     (void)SvUPGRADE(sv, SVt_PV);
  1431.     len = *lp = strlen(tokenbuf);
  1432.     s = SvGROW(sv, len + 1);
  1433.     SvCUR_set(sv, len);
  1434.     (void)strcpy(s, tokenbuf);
  1435.     /* NO SvPOK_on(sv) here! */
  1436.     return s;
  1437.     }
  1438. }
  1439.  
  1440. /* This function is only called on magical items */
  1441. bool
  1442. sv_2bool(sv)
  1443. register SV *sv;
  1444. {
  1445.     if (SvGMAGICAL(sv))
  1446.     mg_get(sv);
  1447.  
  1448.     if (!SvOK(sv))
  1449.     return 0;
  1450.     if (SvROK(sv)) {
  1451. #ifdef OVERLOAD
  1452.       {
  1453.     SV* tmpsv;
  1454.     if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
  1455.       return SvTRUE(tmpsv);
  1456.       }
  1457. #endif /* OVERLOAD */
  1458.       return SvRV(sv) != 0;
  1459.     }
  1460.     if (SvPOKp(sv)) {
  1461.     register XPV* Xpv;
  1462.     if ((Xpv = (XPV*)SvANY(sv)) &&
  1463.         (*Xpv->xpv_pv > '0' ||
  1464.         Xpv->xpv_cur > 1 ||
  1465.         (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
  1466.         return 1;
  1467.     else
  1468.         return 0;
  1469.     }
  1470.     else {
  1471.     if (SvIOKp(sv))
  1472.         return SvIVX(sv) != 0;
  1473.     else {
  1474.         if (SvNOKp(sv))
  1475.         return SvNVX(sv) != 0.0;
  1476.         else
  1477.         return FALSE;
  1478.     }
  1479.     }
  1480. }
  1481.  
  1482. /* Note: sv_setsv() should not be called with a source string that needs
  1483.  * to be reused, since it may destroy the source string if it is marked
  1484.  * as temporary.
  1485.  */
  1486.  
  1487. void
  1488. sv_setsv(dstr,sstr)
  1489. SV *dstr;
  1490. register SV *sstr;
  1491. {
  1492.     register U32 sflags;
  1493.     register int dtype;
  1494.     register int stype;
  1495.  
  1496.     if (sstr == dstr)
  1497.     return;
  1498.     if (SvTHINKFIRST(dstr)) {
  1499.     if (SvREADONLY(dstr) && curcop != &compiling)
  1500.         croak(no_modify);
  1501.     if (SvROK(dstr))
  1502.         sv_unref(dstr);
  1503.     }
  1504.     if (!sstr)
  1505.     sstr = &sv_undef;
  1506.     stype = SvTYPE(sstr);
  1507.     dtype = SvTYPE(dstr);
  1508.  
  1509.     if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
  1510.         sv_unglob(dstr);     /* so fake GLOB won't perpetuate */
  1511.     sv_setpvn(dstr, "", 0);
  1512.         (void)SvPOK_only(dstr);
  1513.         dtype = SvTYPE(dstr);
  1514.     }
  1515.  
  1516. #ifdef OVERLOAD
  1517.     SvAMAGIC_off(dstr);
  1518. #endif /* OVERLOAD */
  1519.     /* There's a lot of redundancy below but we're going for speed here */
  1520.  
  1521.     switch (stype) {
  1522.     case SVt_NULL:
  1523.     (void)SvOK_off(dstr);
  1524.     return;
  1525.     case SVt_IV:
  1526.     if (dtype <= SVt_PV) {
  1527.         if (dtype < SVt_IV)
  1528.         sv_upgrade(dstr, SVt_IV);
  1529.         else if (dtype == SVt_NV)
  1530.         sv_upgrade(dstr, SVt_PVNV);
  1531.         else if (dtype <= SVt_PV)
  1532.         sv_upgrade(dstr, SVt_PVIV);
  1533.     }
  1534.     break;
  1535.     case SVt_NV:
  1536.     if (dtype <= SVt_PVIV) {
  1537.         if (dtype < SVt_NV)
  1538.         sv_upgrade(dstr, SVt_NV);
  1539.         else if (dtype == SVt_PVIV)
  1540.         sv_upgrade(dstr, SVt_PVNV);
  1541.         else if (dtype <= SVt_PV)
  1542.         sv_upgrade(dstr, SVt_PVNV);
  1543.     }
  1544.     break;
  1545.     case SVt_RV:
  1546.     if (dtype < SVt_RV)
  1547.         sv_upgrade(dstr, SVt_RV);
  1548.     else if (dtype == SVt_PVGV &&
  1549.          SvTYPE(SvRV(sstr)) == SVt_PVGV) {
  1550.         sstr = SvRV(sstr);
  1551.         if (sstr == dstr) {
  1552.         if (curcop->cop_stash != GvSTASH(dstr))
  1553.             GvIMPORTED_on(dstr);
  1554.         GvMULTI_on(dstr);
  1555.         return;
  1556.         }
  1557.         goto glob_assign;
  1558.     }
  1559.     break;
  1560.     case SVt_PV:
  1561.     if (dtype < SVt_PV)
  1562.         sv_upgrade(dstr, SVt_PV);
  1563.     break;
  1564.     case SVt_PVIV:
  1565.     if (dtype < SVt_PVIV)
  1566.         sv_upgrade(dstr, SVt_PVIV);
  1567.     break;
  1568.     case SVt_PVNV:
  1569.     if (dtype < SVt_PVNV)
  1570.         sv_upgrade(dstr, SVt_PVNV);
  1571.     break;
  1572.  
  1573.     case SVt_PVLV:
  1574.     sv_upgrade(dstr, SVt_PVNV);
  1575.     break;
  1576.  
  1577.     case SVt_PVAV:
  1578.     case SVt_PVHV:
  1579.     case SVt_PVCV:
  1580.     case SVt_PVIO:
  1581.     if (op)
  1582.         croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
  1583.         op_name[op->op_type]);
  1584.     else
  1585.         croak("Bizarre copy of %s", sv_reftype(sstr, 0));
  1586.     break;
  1587.  
  1588.     case SVt_PVGV:
  1589.     if (dtype <= SVt_PVGV) {
  1590.   glob_assign:
  1591.         if (dtype != SVt_PVGV) {
  1592.         char *name = GvNAME(sstr);
  1593.         STRLEN len = GvNAMELEN(sstr);
  1594.         sv_upgrade(dstr, SVt_PVGV);
  1595.         sv_magic(dstr, dstr, '*', name, len);
  1596.         GvSTASH(dstr) = GvSTASH(sstr);
  1597.         GvNAME(dstr) = savepvn(name, len);
  1598.         GvNAMELEN(dstr) = len;
  1599.         SvFAKE_on(dstr);    /* can coerce to non-glob */
  1600.         }
  1601.         (void)SvOK_off(dstr);
  1602.         GvINTRO_off(dstr);        /* one-shot flag */
  1603.         gp_free(dstr);
  1604.         GvGP(dstr) = gp_ref(GvGP(sstr));
  1605.         SvTAINT(dstr);
  1606.         if (curcop->cop_stash != GvSTASH(dstr))
  1607.         GvIMPORTED_on(dstr);
  1608.         GvMULTI_on(dstr);
  1609.         return;
  1610.     }
  1611.     /* FALL THROUGH */
  1612.  
  1613.     default:
  1614.     if (dtype < stype)
  1615.         sv_upgrade(dstr, stype);
  1616.     if (SvGMAGICAL(sstr))
  1617.         mg_get(sstr);
  1618.     }
  1619.  
  1620.     sflags = SvFLAGS(sstr);
  1621.  
  1622.     if (sflags & SVf_ROK) {
  1623.     if (dtype >= SVt_PV) {
  1624.         if (dtype == SVt_PVGV) {
  1625.         SV *sref = SvREFCNT_inc(SvRV(sstr));
  1626.         SV *dref = 0;
  1627.         int intro = GvINTRO(dstr);
  1628.  
  1629.         if (intro) {
  1630.             GP *gp;
  1631.             GvGP(dstr)->gp_refcnt--;
  1632.             GvINTRO_off(dstr);    /* one-shot flag */
  1633.             Newz(602,gp, 1, GP);
  1634.             GvGP(dstr) = gp;
  1635.             GvREFCNT(dstr) = 1;
  1636.             GvSV(dstr) = NEWSV(72,0);
  1637.             GvLINE(dstr) = curcop->cop_line;
  1638.             GvEGV(dstr) = dstr;
  1639.         }
  1640.         GvMULTI_on(dstr);
  1641.         switch (SvTYPE(sref)) {
  1642.         case SVt_PVAV:
  1643.             if (intro)
  1644.             SAVESPTR(GvAV(dstr));
  1645.             else
  1646.             dref = (SV*)GvAV(dstr);
  1647.             GvAV(dstr) = (AV*)sref;
  1648.             if (curcop->cop_stash != GvSTASH(dstr))
  1649.             GvIMPORTED_AV_on(dstr);
  1650.             break;
  1651.         case SVt_PVHV:
  1652.             if (intro)
  1653.             SAVESPTR(GvHV(dstr));
  1654.             else
  1655.             dref = (SV*)GvHV(dstr);
  1656.             GvHV(dstr) = (HV*)sref;
  1657.             if (curcop->cop_stash != GvSTASH(dstr))
  1658.             GvIMPORTED_HV_on(dstr);
  1659.             break;
  1660.         case SVt_PVCV:
  1661.             if (intro)
  1662.             SAVESPTR(GvCV(dstr));
  1663.             else {
  1664.             CV* cv = GvCV(dstr);
  1665.             if (cv) {
  1666.                 dref = (SV*)cv;
  1667.                 if (dowarn && sref != dref &&
  1668.                     !GvCVGEN((GV*)dstr) &&
  1669.                     (CvROOT(cv) || CvXSUB(cv)) )
  1670.                 warn("Subroutine %s redefined",
  1671.                     GvENAME((GV*)dstr));
  1672.                 SvFAKE_on(cv);
  1673.             }
  1674.             }
  1675.             if (GvCV(dstr) != (CV*)sref) {
  1676.             GvCV(dstr) = (CV*)sref;
  1677.             GvASSUMECV_on(dstr);
  1678.             }
  1679.             if (curcop->cop_stash != GvSTASH(dstr))
  1680.             GvIMPORTED_CV_on(dstr);
  1681.             break;
  1682.         case SVt_PVIO:
  1683.             if (intro)
  1684.             SAVESPTR(GvIOp(dstr));
  1685.             else
  1686.             dref = (SV*)GvIOp(dstr);
  1687.             GvIOp(dstr) = (IO*)sref;
  1688.             break;
  1689.         default:
  1690.             if (intro)
  1691.             SAVESPTR(GvSV(dstr));
  1692.             else
  1693.             dref = (SV*)GvSV(dstr);
  1694.             GvSV(dstr) = sref;
  1695.             if (curcop->cop_stash != GvSTASH(dstr))
  1696.             GvIMPORTED_SV_on(dstr);
  1697.             break;
  1698.         }
  1699.         if (dref)
  1700.             SvREFCNT_dec(dref);
  1701.         if (intro)
  1702.             SAVEFREESV(sref);
  1703.         SvTAINT(dstr);
  1704.         return;
  1705.         }
  1706.         if (SvPVX(dstr)) {
  1707.         Safefree(SvPVX(dstr));
  1708.         SvLEN(dstr)=SvCUR(dstr)=0;
  1709.         }
  1710.     }
  1711.     (void)SvOK_off(dstr);
  1712.     SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
  1713.     SvROK_on(dstr);
  1714.     if (sflags & SVp_NOK) {
  1715.         SvNOK_on(dstr);
  1716.         SvNVX(dstr) = SvNVX(sstr);
  1717.     }
  1718.     if (sflags & SVp_IOK) {
  1719.         (void)SvIOK_on(dstr);
  1720.         SvIVX(dstr) = SvIVX(sstr);
  1721.     }
  1722. #ifdef OVERLOAD
  1723.     if (SvAMAGIC(sstr)) {
  1724.         SvAMAGIC_on(dstr);
  1725.     }
  1726. #endif /* OVERLOAD */
  1727.     }
  1728.     else if (sflags & SVp_POK) {
  1729.  
  1730.     /*
  1731.      * Check to see if we can just swipe the string.  If so, it's a
  1732.      * possible small lose on short strings, but a big win on long ones.
  1733.      * It might even be a win on short strings if SvPVX(dstr)
  1734.      * has to be allocated and SvPVX(sstr) has to be freed.
  1735.      */
  1736.  
  1737.     if (SvTEMP(sstr) &&        /* slated for free anyway? */
  1738.         !(sflags & SVf_OOK))     /* and not involved in OOK hack? */
  1739.     {
  1740.         if (SvPVX(dstr)) {        /* we know that dtype >= SVt_PV */
  1741.         if (SvOOK(dstr)) {
  1742.             SvFLAGS(dstr) &= ~SVf_OOK;
  1743.             Safefree(SvPVX(dstr) - SvIVX(dstr));
  1744.         }
  1745.         else
  1746.             Safefree(SvPVX(dstr));
  1747.         }
  1748.         (void)SvPOK_only(dstr);
  1749.         SvPV_set(dstr, SvPVX(sstr));
  1750.         SvLEN_set(dstr, SvLEN(sstr));
  1751.         SvCUR_set(dstr, SvCUR(sstr));
  1752.         SvTEMP_off(dstr);
  1753.         (void)SvOK_off(sstr);
  1754.         SvPV_set(sstr, Nullch);
  1755.         SvLEN_set(sstr, 0);
  1756.         SvCUR_set(sstr, 0);
  1757.         SvTEMP_off(sstr);
  1758.     }
  1759.     else {                    /* have to copy actual string */
  1760.         STRLEN len = SvCUR(sstr);
  1761.  
  1762.         SvGROW(dstr, len + 1);        /* inlined from sv_setpvn */
  1763.         Move(SvPVX(sstr),SvPVX(dstr),len,char);
  1764.         SvCUR_set(dstr, len);
  1765.         *SvEND(dstr) = '\0';
  1766.         (void)SvPOK_only(dstr);
  1767.     }
  1768.     /*SUPPRESS 560*/
  1769.     if (sflags & SVp_NOK) {
  1770.         SvNOK_on(dstr);
  1771.         SvNVX(dstr) = SvNVX(sstr);
  1772.     }
  1773.     if (sflags & SVp_IOK) {
  1774.         (void)SvIOK_on(dstr);
  1775.         SvIVX(dstr) = SvIVX(sstr);
  1776.     }
  1777.     }
  1778.     else if (sflags & SVp_NOK) {
  1779.     SvNVX(dstr) = SvNVX(sstr);
  1780.     (void)SvNOK_only(dstr);
  1781.     if (SvIOK(sstr)) {
  1782.         (void)SvIOK_on(dstr);
  1783.         SvIVX(dstr) = SvIVX(sstr);
  1784.     }
  1785.     }
  1786.     else if (sflags & SVp_IOK) {
  1787.     (void)SvIOK_only(dstr);
  1788.     SvIVX(dstr) = SvIVX(sstr);
  1789.     }
  1790.     else {
  1791.     (void)SvOK_off(dstr);
  1792.     }
  1793.     SvTAINT(dstr);
  1794. }
  1795.  
  1796. void
  1797. sv_setpvn(sv,ptr,len)
  1798. register SV *sv;
  1799. register char *ptr;
  1800. register STRLEN len;
  1801. {
  1802.     assert(len >= 0);
  1803.     if (SvTHINKFIRST(sv)) {
  1804.     if (SvREADONLY(sv) && curcop != &compiling)
  1805.         croak(no_modify);
  1806.     if (SvROK(sv))
  1807.         sv_unref(sv);
  1808.     }
  1809.     if (!ptr) {
  1810.     (void)SvOK_off(sv);
  1811.     return;
  1812.     }
  1813.     if (SvTYPE(sv) >= SVt_PV) {
  1814.     if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
  1815.         sv_unglob(sv);
  1816.     }
  1817.     else if (!sv_upgrade(sv, SVt_PV))
  1818.     return;
  1819.     SvGROW(sv, len + 1);
  1820.     Move(ptr,SvPVX(sv),len,char);
  1821.     SvCUR_set(sv, len);
  1822.     *SvEND(sv) = '\0';
  1823.     (void)SvPOK_only(sv);        /* validate pointer */
  1824.     SvTAINT(sv);
  1825. }
  1826.  
  1827. void
  1828. sv_setpv(sv,ptr)
  1829. register SV *sv;
  1830. register char *ptr;
  1831. {
  1832.     register STRLEN len;
  1833.  
  1834.     if (SvTHINKFIRST(sv)) {
  1835.     if (SvREADONLY(sv) && curcop != &compiling)
  1836.         croak(no_modify);
  1837.     if (SvROK(sv))
  1838.         sv_unref(sv);
  1839.     }
  1840.     if (!ptr) {
  1841.     (void)SvOK_off(sv);
  1842.     return;
  1843.     }
  1844.     len = strlen(ptr);
  1845.     if (SvTYPE(sv) >= SVt_PV) {
  1846.     if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
  1847.         sv_unglob(sv);
  1848.     }
  1849.     else if (!sv_upgrade(sv, SVt_PV))
  1850.     return;
  1851.     SvGROW(sv, len + 1);
  1852.     Move(ptr,SvPVX(sv),len+1,char);
  1853.     SvCUR_set(sv, len);
  1854.     (void)SvPOK_only(sv);        /* validate pointer */
  1855.     SvTAINT(sv);
  1856. }
  1857.  
  1858. void
  1859. sv_usepvn(sv,ptr,len)
  1860. register SV *sv;
  1861. register char *ptr;
  1862. register STRLEN len;
  1863. {
  1864.     if (SvTHINKFIRST(sv)) {
  1865.     if (SvREADONLY(sv) && curcop != &compiling)
  1866.         croak(no_modify);
  1867.     if (SvROK(sv))
  1868.         sv_unref(sv);
  1869.     }
  1870.     if (!SvUPGRADE(sv, SVt_PV))
  1871.     return;
  1872.     if (!ptr) {
  1873.     (void)SvOK_off(sv);
  1874.     return;
  1875.     }
  1876.     if (SvPVX(sv))
  1877.     Safefree(SvPVX(sv));
  1878.     Renew(ptr, len+1, char);
  1879.     SvPVX(sv) = ptr;
  1880.     SvCUR_set(sv, len);
  1881.     SvLEN_set(sv, len+1);
  1882.     *SvEND(sv) = '\0';
  1883.     (void)SvPOK_only(sv);        /* validate pointer */
  1884.     SvTAINT(sv);
  1885. }
  1886.  
  1887. void
  1888. sv_chop(sv,ptr)    /* like set but assuming ptr is in sv */
  1889. register SV *sv;
  1890. register char *ptr;
  1891. {
  1892.     register STRLEN delta;
  1893.  
  1894.     if (!ptr || !SvPOKp(sv))
  1895.     return;
  1896.     if (SvTHINKFIRST(sv)) {
  1897.     if (SvREADONLY(sv) && curcop != &compiling)
  1898.         croak(no_modify);
  1899.     if (SvROK(sv))
  1900.         sv_unref(sv);
  1901.     }
  1902.     if (SvTYPE(sv) < SVt_PVIV)
  1903.     sv_upgrade(sv,SVt_PVIV);
  1904.  
  1905.     if (!SvOOK(sv)) {
  1906.     SvIVX(sv) = 0;
  1907.     SvFLAGS(sv) |= SVf_OOK;
  1908.     }
  1909.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
  1910.     delta = ptr - SvPVX(sv);
  1911.     SvLEN(sv) -= delta;
  1912.     SvCUR(sv) -= delta;
  1913.     SvPVX(sv) += delta;
  1914.     SvIVX(sv) += delta;
  1915. }
  1916.  
  1917. void
  1918. sv_catpvn(sv,ptr,len)
  1919. register SV *sv;
  1920. register char *ptr;
  1921. register STRLEN len;
  1922. {
  1923.     STRLEN tlen;
  1924.     char *junk;
  1925.  
  1926.     junk = SvPV_force(sv, tlen);
  1927.     SvGROW(sv, tlen + len + 1);
  1928.     if (ptr == junk)
  1929.     ptr = SvPVX(sv);
  1930.     Move(ptr,SvPVX(sv)+tlen,len,char);
  1931.     SvCUR(sv) += len;
  1932.     *SvEND(sv) = '\0';
  1933.     (void)SvPOK_only(sv);        /* validate pointer */
  1934.     SvTAINT(sv);
  1935. }
  1936.  
  1937. void
  1938. sv_catsv(dstr,sstr)
  1939. SV *dstr;
  1940. register SV *sstr;
  1941. {
  1942.     char *s;
  1943.     STRLEN len;
  1944.     if (!sstr)
  1945.     return;
  1946.     if (s = SvPV(sstr, len))
  1947.     sv_catpvn(dstr,s,len);
  1948. }
  1949.  
  1950. void
  1951. sv_catpv(sv,ptr)
  1952. register SV *sv;
  1953. register char *ptr;
  1954. {
  1955.     register STRLEN len;
  1956.     STRLEN tlen;
  1957.     char *junk;
  1958.  
  1959.     if (!ptr)
  1960.     return;
  1961.     junk = SvPV_force(sv, tlen);
  1962.     len = strlen(ptr);
  1963.     SvGROW(sv, tlen + len + 1);
  1964.     if (ptr == junk)
  1965.     ptr = SvPVX(sv);
  1966.     Move(ptr,SvPVX(sv)+tlen,len+1,char);
  1967.     SvCUR(sv) += len;
  1968.     (void)SvPOK_only(sv);        /* validate pointer */
  1969.     SvTAINT(sv);
  1970. }
  1971.  
  1972. SV *
  1973. #ifdef LEAKTEST
  1974. newSV(x,len)
  1975. I32 x;
  1976. #else
  1977. newSV(len)
  1978. #endif
  1979. STRLEN len;
  1980. {
  1981.     register SV *sv;
  1982.     
  1983.     new_SV();
  1984.     SvANY(sv) = 0;
  1985.     SvREFCNT(sv) = 1;
  1986.     SvFLAGS(sv) = 0;
  1987.     if (len) {
  1988.     sv_upgrade(sv, SVt_PV);
  1989.     SvGROW(sv, len + 1);
  1990.     }
  1991.     return sv;
  1992. }
  1993.  
  1994. void
  1995. sv_magic(sv, obj, how, name, namlen)
  1996. register SV *sv;
  1997. SV *obj;
  1998. int how;
  1999. char *name;
  2000. I32 namlen;
  2001. {
  2002.     MAGIC* mg;
  2003.     
  2004.     if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
  2005.     croak(no_modify);
  2006.     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
  2007.     if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
  2008.         if (how == 't')
  2009.         mg->mg_len |= 1;
  2010.         return;
  2011.     }
  2012.     }
  2013.     else {
  2014.     if (!SvUPGRADE(sv, SVt_PVMG))
  2015.         return;
  2016.     }
  2017.     Newz(702,mg, 1, MAGIC);
  2018.     mg->mg_moremagic = SvMAGIC(sv);
  2019.  
  2020.     SvMAGIC(sv) = mg;
  2021.     if (!obj || obj == sv || how == '#')
  2022.     mg->mg_obj = obj;
  2023.     else {
  2024.     mg->mg_obj = SvREFCNT_inc(obj);
  2025.     mg->mg_flags |= MGf_REFCOUNTED;
  2026.     }
  2027.     mg->mg_type = how;
  2028.     mg->mg_len = namlen;
  2029.     if (name && namlen >= 0)
  2030.     mg->mg_ptr = savepvn(name, namlen);
  2031.     switch (how) {
  2032.     case 0:
  2033.     mg->mg_virtual = &vtbl_sv;
  2034.     break;
  2035. #ifdef OVERLOAD
  2036.     case 'A':
  2037.         mg->mg_virtual = &vtbl_amagic;
  2038.         break;
  2039.     case 'a':
  2040.         mg->mg_virtual = &vtbl_amagicelem;
  2041.         break;
  2042.     case 'c':
  2043.         mg->mg_virtual = 0;
  2044.         break;
  2045. #endif /* OVERLOAD */
  2046.     case 'B':
  2047.     mg->mg_virtual = &vtbl_bm;
  2048.     break;
  2049.     case 'E':
  2050.     mg->mg_virtual = &vtbl_env;
  2051.     break;
  2052.     case 'e':
  2053.     mg->mg_virtual = &vtbl_envelem;
  2054.     break;
  2055.     case 'g':
  2056.     mg->mg_virtual = &vtbl_mglob;
  2057.     break;
  2058.     case 'I':
  2059.     mg->mg_virtual = &vtbl_isa;
  2060.     break;
  2061.     case 'i':
  2062.     mg->mg_virtual = &vtbl_isaelem;
  2063.     break;
  2064.     case 'L':
  2065.     SvRMAGICAL_on(sv);
  2066.     mg->mg_virtual = 0;
  2067.     break;
  2068.     case 'l':
  2069.     mg->mg_virtual = &vtbl_dbline;
  2070.     break;
  2071.     case 'P':
  2072.     mg->mg_virtual = &vtbl_pack;
  2073.     break;
  2074.     case 'p':
  2075.     case 'q':
  2076.     mg->mg_virtual = &vtbl_packelem;
  2077.     break;
  2078.     case 'S':
  2079.     mg->mg_virtual = &vtbl_sig;
  2080.     break;
  2081.     case 's':
  2082.     mg->mg_virtual = &vtbl_sigelem;
  2083.     break;
  2084.     case 't':
  2085.     mg->mg_virtual = &vtbl_taint;
  2086.     mg->mg_len = 1;
  2087.     break;
  2088.     case 'U':
  2089.     mg->mg_virtual = &vtbl_uvar;
  2090.     break;
  2091.     case 'v':
  2092.     mg->mg_virtual = &vtbl_vec;
  2093.     break;
  2094.     case 'x':
  2095.     mg->mg_virtual = &vtbl_substr;
  2096.     break;
  2097.     case '*':
  2098.     mg->mg_virtual = &vtbl_glob;
  2099.     break;
  2100.     case '#':
  2101.     mg->mg_virtual = &vtbl_arylen;
  2102.     break;
  2103.     case '.':
  2104.     mg->mg_virtual = &vtbl_pos;
  2105.     break;
  2106.     case '~':    /* Reserved for use by extensions not perl internals.    */
  2107.     /* Useful for attaching extension internal data to perl vars.    */
  2108.     /* Note that multiple extensions may clash if magical scalars    */
  2109.     /* etc holding private data from one are passed to another.    */
  2110.     SvRMAGICAL_on(sv);
  2111.     break;
  2112.     default:
  2113.     croak("Don't know how to handle magic of type '%c'", how);
  2114.     }
  2115.     mg_magical(sv);
  2116.     if (SvGMAGICAL(sv))
  2117.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  2118. }
  2119.  
  2120. int
  2121. sv_unmagic(sv, type)
  2122. SV* sv;
  2123. int type;
  2124. {
  2125.     MAGIC* mg;
  2126.     MAGIC** mgp;
  2127.     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
  2128.     return 0;
  2129.     mgp = &SvMAGIC(sv);
  2130.     for (mg = *mgp; mg; mg = *mgp) {
  2131.     if (mg->mg_type == type) {
  2132.         MGVTBL* vtbl = mg->mg_virtual;
  2133.         *mgp = mg->mg_moremagic;
  2134.         if (vtbl && vtbl->svt_free)
  2135.         (*vtbl->svt_free)(sv, mg);
  2136.         if (mg->mg_ptr && mg->mg_type != 'g')
  2137.         Safefree(mg->mg_ptr);
  2138.         if (mg->mg_flags & MGf_REFCOUNTED)
  2139.         SvREFCNT_dec(mg->mg_obj);
  2140.         Safefree(mg);
  2141.     }
  2142.     else
  2143.         mgp = &mg->mg_moremagic;
  2144.     }
  2145.     if (!SvMAGIC(sv)) {
  2146.     SvMAGICAL_off(sv);
  2147.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  2148.     }
  2149.  
  2150.     return 0;
  2151. }
  2152.  
  2153. void
  2154. sv_insert(bigstr,offset,len,little,littlelen)
  2155. SV *bigstr;
  2156. STRLEN offset;
  2157. STRLEN len;
  2158. char *little;
  2159. STRLEN littlelen;
  2160. {
  2161.     register char *big;
  2162.     register char *mid;
  2163.     register char *midend;
  2164.     register char *bigend;
  2165.     register I32 i;
  2166.  
  2167.     if (!bigstr)
  2168.     croak("Can't modify non-existent substring");
  2169.     SvPV_force(bigstr, na);
  2170.  
  2171.     i = littlelen - len;
  2172.     if (i > 0) {            /* string might grow */
  2173.     big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
  2174.     mid = big + offset + len;
  2175.     midend = bigend = big + SvCUR(bigstr);
  2176.     bigend += i;
  2177.     *bigend = '\0';
  2178.     while (midend > mid)        /* shove everything down */
  2179.         *--bigend = *--midend;
  2180.     Move(little,big+offset,littlelen,char);
  2181.     SvCUR(bigstr) += i;
  2182.     SvSETMAGIC(bigstr);
  2183.     return;
  2184.     }
  2185.     else if (i == 0) {
  2186.     Move(little,SvPVX(bigstr)+offset,len,char);
  2187.     SvSETMAGIC(bigstr);
  2188.     return;
  2189.     }
  2190.  
  2191.     big = SvPVX(bigstr);
  2192.     mid = big + offset;
  2193.     midend = mid + len;
  2194.     bigend = big + SvCUR(bigstr);
  2195.  
  2196.     if (midend > bigend)
  2197.     croak("panic: sv_insert");
  2198.  
  2199.     if (mid - big > bigend - midend) {    /* faster to shorten from end */
  2200.     if (littlelen) {
  2201.         Move(little, mid, littlelen,char);
  2202.         mid += littlelen;
  2203.     }
  2204.     i = bigend - midend;
  2205.     if (i > 0) {
  2206.         Move(midend, mid, i,char);
  2207.         mid += i;
  2208.     }
  2209.     *mid = '\0';
  2210.     SvCUR_set(bigstr, mid - big);
  2211.     }
  2212.     /*SUPPRESS 560*/
  2213.     else if (i = mid - big) {    /* faster from front */
  2214.     midend -= littlelen;
  2215.     mid = midend;
  2216.     sv_chop(bigstr,midend-i);
  2217.     big += i;
  2218.     while (i--)
  2219.         *--midend = *--big;
  2220.     if (littlelen)
  2221.         Move(little, mid, littlelen,char);
  2222.     }
  2223.     else if (littlelen) {
  2224.     midend -= littlelen;
  2225.     sv_chop(bigstr,midend);
  2226.     Move(little,midend,littlelen,char);
  2227.     }
  2228.     else {
  2229.     sv_chop(bigstr,midend);
  2230.     }
  2231.     SvSETMAGIC(bigstr);
  2232. }
  2233.  
  2234. /* make sv point to what nstr did */
  2235.  
  2236. void
  2237. sv_replace(sv,nsv)
  2238. register SV *sv;
  2239. register SV *nsv;
  2240. {
  2241.     U32 refcnt = SvREFCNT(sv);
  2242.     if (SvTHINKFIRST(sv)) {
  2243.     if (SvREADONLY(sv) && curcop != &compiling)
  2244.         croak(no_modify);
  2245.     if (SvROK(sv))
  2246.         sv_unref(sv);
  2247.     }
  2248.     if (SvREFCNT(nsv) != 1)
  2249.     warn("Reference miscount in sv_replace()");
  2250.     if (SvMAGICAL(sv)) {
  2251.     if (SvMAGICAL(nsv))
  2252.         mg_free(nsv);
  2253.     else
  2254.         sv_upgrade(nsv, SVt_PVMG);
  2255.     SvMAGIC(nsv) = SvMAGIC(sv);
  2256.     SvFLAGS(nsv) |= SvMAGICAL(sv);
  2257.     SvMAGICAL_off(sv);
  2258.     SvMAGIC(sv) = 0;
  2259.     }
  2260.     SvREFCNT(sv) = 0;
  2261.     sv_clear(sv);
  2262.     StructCopy(nsv,sv,SV);
  2263.     SvREFCNT(sv) = refcnt;
  2264.     del_SV(nsv);
  2265. }
  2266.  
  2267. void
  2268. sv_clear(sv)
  2269. register SV *sv;
  2270. {
  2271.     assert(sv);
  2272.     assert(SvREFCNT(sv) == 0);
  2273.  
  2274.     if (SvOBJECT(sv)) {
  2275.     dSP;
  2276.     GV* destructor;
  2277.  
  2278.     if (defstash) {        /* Still have a symbol table? */
  2279.         destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
  2280.  
  2281.         ENTER;
  2282.         SAVEFREESV(SvSTASH(sv));
  2283.         if (destructor && GvCV(destructor)) {
  2284.         SV ref;
  2285.  
  2286.         Zero(&ref, 1, SV);
  2287.         sv_upgrade(&ref, SVt_RV);
  2288.         SAVEI32(SvREFCNT(sv));
  2289.         SvRV(&ref) = SvREFCNT_inc(sv);
  2290.         SvROK_on(&ref);
  2291.  
  2292.         EXTEND(SP, 2);
  2293.         PUSHMARK(SP);
  2294.         PUSHs(&ref);
  2295.         PUTBACK;
  2296.         perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
  2297.         del_XRV(SvANY(&ref));
  2298.         }
  2299.         LEAVE;
  2300.     }
  2301.     else
  2302.         SvREFCNT_dec(SvSTASH(sv));
  2303.     if (SvOBJECT(sv)) {
  2304.         SvOBJECT_off(sv);    /* Curse the object. */
  2305.         if (SvTYPE(sv) != SVt_PVIO)
  2306.         --sv_objcount;    /* XXX Might want something more general */
  2307.     }
  2308.     }
  2309.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
  2310.     mg_free(sv);
  2311.     switch (SvTYPE(sv)) {
  2312.     case SVt_PVIO:
  2313.     io_close((IO*)sv);
  2314.     Safefree(IoTOP_NAME(sv));
  2315.     Safefree(IoFMT_NAME(sv));
  2316.     Safefree(IoBOTTOM_NAME(sv));
  2317.     /* FALL THROUGH */
  2318.     case SVt_PVBM:
  2319.     goto freescalar;
  2320.     case SVt_PVCV:
  2321.     case SVt_PVFM:
  2322.     cv_undef((CV*)sv);
  2323.     goto freescalar;
  2324.     case SVt_PVHV:
  2325.     hv_undef((HV*)sv);
  2326.     break;
  2327.     case SVt_PVAV:
  2328.     av_undef((AV*)sv);
  2329.     break;
  2330.     case SVt_PVGV:
  2331.     gp_free(sv);
  2332.     Safefree(GvNAME(sv));
  2333.     /* FALL THROUGH */
  2334.     case SVt_PVLV:
  2335.     case SVt_PVMG:
  2336.     case SVt_PVNV:
  2337.     case SVt_PVIV:
  2338.       freescalar:
  2339.     (void)SvOOK_off(sv);
  2340.     /* FALL THROUGH */
  2341.     case SVt_PV:
  2342.     case SVt_RV:
  2343.     if (SvROK(sv))
  2344.         SvREFCNT_dec(SvRV(sv));
  2345.     else if (SvPVX(sv))
  2346.         Safefree(SvPVX(sv));
  2347.     break;
  2348. /*
  2349.     case SVt_NV:
  2350.     case SVt_IV:
  2351.     case SVt_NULL:
  2352.     break;
  2353. */
  2354.     }
  2355.  
  2356.     switch (SvTYPE(sv)) {
  2357.     case SVt_NULL:
  2358.     break;
  2359.     case SVt_IV:
  2360.     del_XIV(SvANY(sv));
  2361.     break;
  2362.     case SVt_NV:
  2363.     del_XNV(SvANY(sv));
  2364.     break;
  2365.     case SVt_RV:
  2366.     del_XRV(SvANY(sv));
  2367.     break;
  2368.     case SVt_PV:
  2369.     del_XPV(SvANY(sv));
  2370.     break;
  2371.     case SVt_PVIV:
  2372.     del_XPVIV(SvANY(sv));
  2373.     break;
  2374.     case SVt_PVNV:
  2375.     del_XPVNV(SvANY(sv));
  2376.     break;
  2377.     case SVt_PVMG:
  2378.     del_XPVMG(SvANY(sv));
  2379.     break;
  2380.     case SVt_PVLV:
  2381.     del_XPVLV(SvANY(sv));
  2382.     break;
  2383.     case SVt_PVAV:
  2384.     del_XPVAV(SvANY(sv));
  2385.     break;
  2386.     case SVt_PVHV:
  2387.     del_XPVHV(SvANY(sv));
  2388.     break;
  2389.     case SVt_PVCV:
  2390.     del_XPVCV(SvANY(sv));
  2391.     break;
  2392.     case SVt_PVGV:
  2393.     del_XPVGV(SvANY(sv));
  2394.     break;
  2395.     case SVt_PVBM:
  2396.     del_XPVBM(SvANY(sv));
  2397.     break;
  2398.     case SVt_PVFM:
  2399.     del_XPVFM(SvANY(sv));
  2400.     break;
  2401.     case SVt_PVIO:
  2402.     del_XPVIO(SvANY(sv));
  2403.     break;
  2404.     }
  2405.     SvFLAGS(sv) &= SVf_BREAK;
  2406.     SvFLAGS(sv) |= SVTYPEMASK;
  2407. }
  2408.  
  2409. SV *
  2410. sv_newref(sv)
  2411. SV* sv;
  2412. {
  2413.     if (sv)
  2414.     SvREFCNT(sv)++;
  2415.     return sv;
  2416. }
  2417.  
  2418. void
  2419. sv_free(sv)
  2420. SV *sv;
  2421. {
  2422.     if (!sv)
  2423.     return;
  2424.     if (SvREADONLY(sv)) {
  2425.     if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
  2426.         return;
  2427.     }
  2428.     if (SvREFCNT(sv) == 0) {
  2429.     if (SvFLAGS(sv) & SVf_BREAK)
  2430.         return;
  2431.     warn("Attempt to free unreferenced scalar");
  2432.     return;
  2433.     }
  2434.     if (--SvREFCNT(sv) > 0)
  2435.     return;
  2436. #ifdef DEBUGGING
  2437.     if (SvTEMP(sv)) {
  2438.     warn("Attempt to free temp prematurely");
  2439.     return;
  2440.     }
  2441. #endif
  2442.     sv_clear(sv);
  2443.     del_SV(sv);
  2444. }
  2445.  
  2446. STRLEN
  2447. sv_len(sv)
  2448. register SV *sv;
  2449. {
  2450.     char *junk;
  2451.     STRLEN len;
  2452.  
  2453.     if (!sv)
  2454.     return 0;
  2455.  
  2456.     if (SvGMAGICAL(sv))
  2457.     len = mg_len(sv);
  2458.     else
  2459.     junk = SvPV(sv, len);
  2460.     return len;
  2461. }
  2462.  
  2463. I32
  2464. sv_eq(str1,str2)
  2465. register SV *str1;
  2466. register SV *str2;
  2467. {
  2468.     char *pv1;
  2469.     STRLEN cur1;
  2470.     char *pv2;
  2471.     STRLEN cur2;
  2472.  
  2473.     if (!str1) {
  2474.     pv1 = "";
  2475.     cur1 = 0;
  2476.     }
  2477.     else
  2478.     pv1 = SvPV(str1, cur1);
  2479.  
  2480.     if (!str2)
  2481.     return !cur1;
  2482.     else
  2483.     pv2 = SvPV(str2, cur2);
  2484.  
  2485.     if (cur1 != cur2)
  2486.     return 0;
  2487.  
  2488.     return !bcmp(pv1, pv2, cur1);
  2489. }
  2490.  
  2491. I32
  2492. sv_cmp(str1,str2)
  2493. register SV *str1;
  2494. register SV *str2;
  2495. {
  2496.     I32 retval;
  2497.     char *pv1;
  2498.     STRLEN cur1;
  2499.     char *pv2;
  2500.     STRLEN cur2;
  2501.  
  2502.     if (!str1) {
  2503.     pv1 = "";
  2504.     cur1 = 0;
  2505.     }
  2506.     else
  2507.     pv1 = SvPV(str1, cur1);
  2508.  
  2509.     if (!str2) {
  2510.     pv2 = "";
  2511.     cur2 = 0;
  2512.     }
  2513.     else
  2514.     pv2 = SvPV(str2, cur2);
  2515.  
  2516.     if (!cur1)
  2517.     return cur2 ? -1 : 0;
  2518.     if (!cur2)
  2519.     return 1;
  2520.  
  2521.     if (cur1 < cur2) {
  2522.     /*SUPPRESS 560*/
  2523.     if (retval = memcmp((void*)pv1, (void*)pv2, cur1))
  2524.         return retval < 0 ? -1 : 1;
  2525.     else
  2526.         return -1;
  2527.     }
  2528.     /*SUPPRESS 560*/
  2529.     else if (retval = memcmp((void*)pv1, (void*)pv2, cur2))
  2530.     return retval < 0 ? -1 : 1;
  2531.     else if (cur1 == cur2)
  2532.     return 0;
  2533.     else
  2534.     return 1;
  2535. }
  2536.  
  2537. char *
  2538. sv_gets(sv,fp,append)
  2539. register SV *sv;
  2540. register FILE *fp;
  2541. I32 append;
  2542. {
  2543.     char *rsptr;
  2544.     STRLEN rslen;
  2545.     register STDCHAR rslast;
  2546.     register STDCHAR *bp;
  2547.     register I32 cnt;
  2548.     I32 i;
  2549.  
  2550. #ifdef FAST_SV_GETS
  2551.     /*
  2552.      * We're going to steal some values from the stdio struct
  2553.      * and put EVERYTHING in the innermost loop into registers.
  2554.      */
  2555.     register STDCHAR *ptr;
  2556.     STRLEN bpx;
  2557.     I32 shortbuffered;
  2558. #endif
  2559.  
  2560.     if (SvTHINKFIRST(sv)) {
  2561.     if (SvREADONLY(sv) && curcop != &compiling)
  2562.         croak(no_modify);
  2563.     if (SvROK(sv))
  2564.         sv_unref(sv);
  2565.     }
  2566.     if (!SvUPGRADE(sv, SVt_PV))
  2567.     return 0;
  2568.  
  2569.     if (RsSNARF(rs)) {
  2570.     rsptr = NULL;
  2571.     rslen = 0;
  2572.     }
  2573.     else if (RsPARA(rs)) {
  2574.     rsptr = "\n\n";
  2575.     rslen = 2;
  2576.     }
  2577.     else
  2578.     rsptr = SvPV(rs, rslen);
  2579.     rslast = rslen ? rsptr[rslen - 1] : '\0';
  2580.  
  2581.     if (RsPARA(rs)) {        /* have to do this both before and after */
  2582.     do {            /* to make sure file boundaries work right */
  2583.         if (feof(fp))
  2584.         return 0;
  2585.         i = getc(fp);
  2586.         if (i != '\n') {
  2587.         if (i == -1)
  2588.             return 0;
  2589.         ungetc(i,fp);
  2590.         break;
  2591.         }
  2592.     } while (i != EOF);
  2593.     }
  2594.  
  2595. #ifdef FAST_SV_GETS
  2596.  
  2597.     /* Here is some breathtakingly efficient cheating */
  2598.  
  2599.     cnt = FILE_cnt(fp);            /* get count into register */
  2600.     (void)SvPOK_only(sv);        /* validate pointer */
  2601.     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
  2602.     if (cnt > 80 && SvLEN(sv) > append) {
  2603.         shortbuffered = cnt - SvLEN(sv) + append + 1;
  2604.         cnt -= shortbuffered;
  2605.     }
  2606.     else {
  2607.         shortbuffered = 0;
  2608.         SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
  2609.     }
  2610.     }
  2611.     else
  2612.     shortbuffered = 0;
  2613.     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
  2614.     ptr = FILE_ptr(fp);
  2615.     for (;;) {
  2616.       screamer:
  2617.     if (cnt > 0) {
  2618.         if (rslen) {
  2619.         while (--cnt >= 0) {             /* this     |  eat */
  2620.             if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
  2621.             goto thats_all_folks;         /* screams  |  sed :-) */
  2622.         }
  2623.         }
  2624.         else {
  2625.             memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */    
  2626.         bp += cnt;                 /* screams  |  dust */   
  2627.         ptr += cnt;                 /* louder   |  sed :-) */
  2628.         cnt = 0;
  2629.         }
  2630.     }
  2631.     
  2632.     if (shortbuffered) {        /* oh well, must extend */
  2633.         cnt = shortbuffered;
  2634.         shortbuffered = 0;
  2635.         bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
  2636.         SvCUR_set(sv, bpx);
  2637.         SvGROW(sv, SvLEN(sv) + append + cnt + 2);
  2638.         bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
  2639.         continue;
  2640.     }
  2641.  
  2642.     FILE_cnt(fp) = cnt;        /* deregisterize cnt and ptr */
  2643.     FILE_ptr(fp) = ptr;
  2644.     i = _filbuf(fp);        /* get more characters */
  2645.     cnt = FILE_cnt(fp);
  2646.     ptr = FILE_ptr(fp);        /* reregisterize cnt and ptr */
  2647.  
  2648.     if (i == EOF)            /* all done for ever? */
  2649.         goto thats_really_all_folks;
  2650.  
  2651.     bpx = bp - (STDCHAR*)SvPVX(sv);    /* box up before relocation */
  2652.     SvCUR_set(sv, bpx);
  2653.     SvGROW(sv, bpx + cnt + 2);
  2654.     bp = (STDCHAR*)SvPVX(sv) + bpx;    /* unbox after relocation */
  2655.  
  2656.     *bp++ = i;            /* store character from _filbuf */
  2657.  
  2658.     if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
  2659.         goto thats_all_folks;
  2660.     }
  2661.  
  2662. thats_all_folks:
  2663.     if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
  2664.       bcmp((char*)bp - rslen, rsptr, rslen))
  2665.     goto screamer;            /* go back to the fray */
  2666. thats_really_all_folks:
  2667.     if (shortbuffered)
  2668.     cnt += shortbuffered;
  2669.     FILE_cnt(fp) = cnt;            /* put these back or we're in trouble */
  2670.     FILE_ptr(fp) = ptr;
  2671.     *bp = '\0';
  2672.     SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));  /* set length */
  2673.  
  2674. #else /* SV_FAST_GETS */
  2675.  
  2676.     /*The big, slow, and stupid way */
  2677.  
  2678.     {
  2679.     STDCHAR buf[8192];
  2680.  
  2681. screamer:
  2682.     if (rslen) {
  2683.         register STDCHAR *bpe = buf + sizeof(buf);
  2684.         bp = buf;
  2685.         while ((i = getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
  2686.         ; /* keep reading */
  2687.         cnt = bp - buf;
  2688.     }
  2689.     else {
  2690.         cnt = fread((char*)buf, 1, sizeof(buf), fp);
  2691.         i = cnt ? (U8)buf[cnt - 1] : EOF;
  2692.     }
  2693.  
  2694.     if (append)
  2695.         sv_catpvn(sv, buf, cnt);
  2696.     else
  2697.         sv_setpvn(sv, buf, cnt);
  2698.  
  2699.     if (i != EOF &&            /* joy */
  2700.         (!rslen ||
  2701.          SvCUR(sv) < rslen ||
  2702.          bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
  2703.     {
  2704.         append = -1;
  2705.         goto screamer;
  2706.     }
  2707.     }
  2708.  
  2709. #endif /* SV_FAST_GETS */
  2710.  
  2711.     if (RsPARA(rs)) {        /* have to do this both before and after */  
  2712.         while (i != EOF) {    /* to make sure file boundaries work right */
  2713.         i = getc(fp);
  2714.         if (i != '\n') {
  2715.         ungetc(i,fp);
  2716.         break;
  2717.         }
  2718.     }
  2719.     }
  2720.  
  2721.     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
  2722. }
  2723.  
  2724. void
  2725. sv_inc(sv)
  2726. register SV *sv;
  2727. {
  2728.     register char *d;
  2729.     int flags;
  2730.  
  2731.     if (!sv)
  2732.     return;
  2733.     if (SvTHINKFIRST(sv)) {
  2734.     if (SvREADONLY(sv) && curcop != &compiling)
  2735.         croak(no_modify);
  2736.     if (SvROK(sv)) {
  2737. #ifdef OVERLOAD
  2738.       if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
  2739. #endif /* OVERLOAD */
  2740.       sv_unref(sv);
  2741.     }
  2742.     }
  2743.     if (SvGMAGICAL(sv))
  2744.     mg_get(sv);
  2745.     flags = SvFLAGS(sv);
  2746.     if (flags & SVp_IOK) {
  2747.     (void)SvIOK_only(sv);
  2748.     ++SvIVX(sv);
  2749.     return;
  2750.     }
  2751.     if (flags & SVp_NOK) {
  2752.     SvNVX(sv) += 1.0;
  2753.     (void)SvNOK_only(sv);
  2754.     return;
  2755.     }
  2756.     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
  2757.     if ((flags & SVTYPEMASK) < SVt_PVNV)
  2758.         sv_upgrade(sv, SVt_NV);
  2759.     SvNVX(sv) = 1.0;
  2760.     (void)SvNOK_only(sv);
  2761.     return;
  2762.     }
  2763.     d = SvPVX(sv);
  2764.     while (isALPHA(*d)) d++;
  2765.     while (isDIGIT(*d)) d++;
  2766.     if (*d) {
  2767.         sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
  2768.     return;
  2769.     }
  2770.     d--;
  2771.     while (d >= SvPVX(sv)) {
  2772.     if (isDIGIT(*d)) {
  2773.         if (++*d <= '9')
  2774.         return;
  2775.         *(d--) = '0';
  2776.     }
  2777.     else {
  2778.         ++*d;
  2779.         if (isALPHA(*d))
  2780.         return;
  2781.         *(d--) -= 'z' - 'a' + 1;
  2782.     }
  2783.     }
  2784.     /* oh,oh, the number grew */
  2785.     SvGROW(sv, SvCUR(sv) + 2);
  2786.     SvCUR(sv)++;
  2787.     for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
  2788.     *d = d[-1];
  2789.     if (isDIGIT(d[1]))
  2790.     *d = '1';
  2791.     else
  2792.     *d = d[1];
  2793. }
  2794.  
  2795. void
  2796. sv_dec(sv)
  2797. register SV *sv;
  2798. {
  2799.     int flags;
  2800.  
  2801.     if (!sv)
  2802.     return;
  2803.     if (SvTHINKFIRST(sv)) {
  2804.     if (SvREADONLY(sv) && curcop != &compiling)
  2805.         croak(no_modify);
  2806.     if (SvROK(sv)) {
  2807. #ifdef OVERLOAD
  2808.       if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
  2809. #endif /* OVERLOAD */
  2810.       sv_unref(sv);
  2811.     }
  2812.     }
  2813.     if (SvGMAGICAL(sv))
  2814.     mg_get(sv);
  2815.     flags = SvFLAGS(sv);
  2816.     if (flags & SVp_IOK) {
  2817.     (void)SvIOK_only(sv);
  2818.     --SvIVX(sv);
  2819.     return;
  2820.     }
  2821.     if (flags & SVp_NOK) {
  2822.     SvNVX(sv) -= 1.0;
  2823.     (void)SvNOK_only(sv);
  2824.     return;
  2825.     }
  2826.     if (!(flags & SVp_POK)) {
  2827.     if ((flags & SVTYPEMASK) < SVt_PVNV)
  2828.         sv_upgrade(sv, SVt_NV);
  2829.     SvNVX(sv) = -1.0;
  2830.     (void)SvNOK_only(sv);
  2831.     return;
  2832.     }
  2833.     sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
  2834. }
  2835.  
  2836. /* Make a string that will exist for the duration of the expression
  2837.  * evaluation.  Actually, it may have to last longer than that, but
  2838.  * hopefully we won't free it until it has been assigned to a
  2839.  * permanent location. */
  2840.  
  2841. static void
  2842. sv_mortalgrow()
  2843. {
  2844.     tmps_max += 128;
  2845.     Renew(tmps_stack, tmps_max, SV*);
  2846. }
  2847.  
  2848. SV *
  2849. sv_mortalcopy(oldstr)
  2850. SV *oldstr;
  2851. {
  2852.     register SV *sv;
  2853.  
  2854.     new_SV();
  2855.     SvANY(sv) = 0;
  2856.     SvREFCNT(sv) = 1;
  2857.     SvFLAGS(sv) = 0;
  2858.     sv_setsv(sv,oldstr);
  2859.     if (++tmps_ix >= tmps_max)
  2860.     sv_mortalgrow();
  2861.     tmps_stack[tmps_ix] = sv;
  2862.     SvTEMP_on(sv);
  2863.     return sv;
  2864. }
  2865.  
  2866. SV *
  2867. sv_newmortal()
  2868. {
  2869.     register SV *sv;
  2870.  
  2871.     new_SV();
  2872.     SvANY(sv) = 0;
  2873.     SvREFCNT(sv) = 1;
  2874.     SvFLAGS(sv) = SVs_TEMP;
  2875.     if (++tmps_ix >= tmps_max)
  2876.     sv_mortalgrow();
  2877.     tmps_stack[tmps_ix] = sv;
  2878.     return sv;
  2879. }
  2880.  
  2881. /* same thing without the copying */
  2882.  
  2883. SV *
  2884. sv_2mortal(sv)
  2885. register SV *sv;
  2886. {
  2887.     if (!sv)
  2888.     return sv;
  2889.     if (SvREADONLY(sv) && curcop != &compiling)
  2890.     croak(no_modify);
  2891.     if (++tmps_ix >= tmps_max)
  2892.     sv_mortalgrow();
  2893.     tmps_stack[tmps_ix] = sv;
  2894.     SvTEMP_on(sv);
  2895.     return sv;
  2896. }
  2897.  
  2898. SV *
  2899. newSVpv(s,len)
  2900. char *s;
  2901. STRLEN len;
  2902. {
  2903.     register SV *sv;
  2904.  
  2905.     new_SV();
  2906.     SvANY(sv) = 0;
  2907.     SvREFCNT(sv) = 1;
  2908.     SvFLAGS(sv) = 0;
  2909.     if (!len)
  2910.     len = strlen(s);
  2911.     sv_setpvn(sv,s,len);
  2912.     return sv;
  2913. }
  2914.  
  2915. SV *
  2916. newSVnv(n)
  2917. double n;
  2918. {
  2919.     register SV *sv;
  2920.  
  2921.     new_SV();
  2922.     SvANY(sv) = 0;
  2923.     SvREFCNT(sv) = 1;
  2924.     SvFLAGS(sv) = 0;
  2925.     sv_setnv(sv,n);
  2926.     return sv;
  2927. }
  2928.  
  2929. SV *
  2930. newSViv(i)
  2931. IV i;
  2932. {
  2933.     register SV *sv;
  2934.  
  2935.     new_SV();
  2936.     SvANY(sv) = 0;
  2937.     SvREFCNT(sv) = 1;
  2938.     SvFLAGS(sv) = 0;
  2939.     sv_setiv(sv,i);
  2940.     return sv;
  2941. }
  2942.  
  2943. SV *
  2944. newRV(ref)
  2945. SV *ref;
  2946. {
  2947.     register SV *sv;
  2948.  
  2949.     new_SV();
  2950.     SvANY(sv) = 0;
  2951.     SvREFCNT(sv) = 1;
  2952.     SvFLAGS(sv) = 0;
  2953.     sv_upgrade(sv, SVt_RV);
  2954.     SvTEMP_off(ref);
  2955.     SvRV(sv) = SvREFCNT_inc(ref);
  2956.     SvROK_on(sv);
  2957.     return sv;
  2958. }
  2959.  
  2960. /* make an exact duplicate of old */
  2961.  
  2962. SV *
  2963. newSVsv(old)
  2964. register SV *old;
  2965. {
  2966.     register SV *sv;
  2967.  
  2968.     if (!old)
  2969.     return Nullsv;
  2970.     if (SvTYPE(old) == SVTYPEMASK) {
  2971.     warn("semi-panic: attempt to dup freed string");
  2972.     return Nullsv;
  2973.     }
  2974.     new_SV();
  2975.     SvANY(sv) = 0;
  2976.     SvREFCNT(sv) = 1;
  2977.     SvFLAGS(sv) = 0;
  2978.     if (SvTEMP(old)) {
  2979.     SvTEMP_off(old);
  2980.     sv_setsv(sv,old);
  2981.     SvTEMP_on(old);
  2982.     }
  2983.     else
  2984.     sv_setsv(sv,old);
  2985.     return sv;
  2986. }
  2987.  
  2988. void
  2989. sv_reset(s,stash)
  2990. register char *s;
  2991. HV *stash;
  2992. {
  2993.     register HE *entry;
  2994.     register GV *gv;
  2995.     register SV *sv;
  2996.     register I32 i;
  2997.     register PMOP *pm;
  2998.     register I32 max;
  2999.     char todo[256];
  3000.  
  3001.     if (!*s) {        /* reset ?? searches */
  3002.     for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
  3003.         pm->op_pmflags &= ~PMf_USED;
  3004.     }
  3005.     return;
  3006.     }
  3007.  
  3008.     /* reset variables */
  3009.  
  3010.     if (!HvARRAY(stash))
  3011.     return;
  3012.  
  3013.     Zero(todo, 256, char);
  3014.     while (*s) {
  3015.     i = *s;
  3016.     if (s[1] == '-') {
  3017.         s += 2;
  3018.     }
  3019.     max = *s++;
  3020.     for ( ; i <= max; i++) {
  3021.         todo[i] = 1;
  3022.     }
  3023.     for (i = 0; i <= (I32) HvMAX(stash); i++) {
  3024.         for (entry = HvARRAY(stash)[i];
  3025.           entry;
  3026.           entry = entry->hent_next) {
  3027.         if (!todo[(U8)*entry->hent_key])
  3028.             continue;
  3029.         gv = (GV*)entry->hent_val;
  3030.         sv = GvSV(gv);
  3031.         (void)SvOK_off(sv);
  3032.         if (SvTYPE(sv) >= SVt_PV) {
  3033.             SvCUR_set(sv, 0);
  3034.             SvTAINT(sv);
  3035.             if (SvPVX(sv) != Nullch)
  3036.             *SvPVX(sv) = '\0';
  3037.         }
  3038.         if (GvAV(gv)) {
  3039.             av_clear(GvAV(gv));
  3040.         }
  3041.         if (GvHV(gv)) {
  3042.             if (HvNAME(GvHV(gv)))
  3043.             continue;
  3044.             hv_clear(GvHV(gv));
  3045. #ifndef VMS  /* VMS has no environ array */
  3046.             if (gv == envgv)
  3047.             environ[0] = Nullch;
  3048. #endif
  3049.         }
  3050.         }
  3051.     }
  3052.     }
  3053. }
  3054.  
  3055. CV *
  3056. sv_2cv(sv, st, gvp, lref)
  3057. SV *sv;
  3058. HV **st;
  3059. GV **gvp;
  3060. I32 lref;
  3061. {
  3062.     GV *gv;
  3063.     CV *cv;
  3064.  
  3065.     if (!sv)
  3066.     return *gvp = Nullgv, Nullcv;
  3067.     switch (SvTYPE(sv)) {
  3068.     case SVt_PVCV:
  3069.     *st = CvSTASH(sv);
  3070.     *gvp = Nullgv;
  3071.     return (CV*)sv;
  3072.     case SVt_PVHV:
  3073.     case SVt_PVAV:
  3074.     *gvp = Nullgv;
  3075.     return Nullcv;
  3076.     case SVt_PVGV:
  3077.     gv = (GV*)sv;
  3078.     *gvp = gv;
  3079.     *st = GvESTASH(gv);
  3080.     goto fix_gv;
  3081.  
  3082.     default:
  3083.     if (SvGMAGICAL(sv))
  3084.         mg_get(sv);
  3085.     if (SvROK(sv)) {
  3086.         cv = (CV*)SvRV(sv);
  3087.         if (SvTYPE(cv) != SVt_PVCV)
  3088.         croak("Not a subroutine reference");
  3089.         *gvp = Nullgv;
  3090.         *st = CvSTASH(cv);
  3091.         return cv;
  3092.     }
  3093.     if (isGV(sv))
  3094.         gv = (GV*)sv;
  3095.     else
  3096.         gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
  3097.     *gvp = gv;
  3098.     if (!gv)
  3099.         return Nullcv;
  3100.     *st = GvESTASH(gv);
  3101.     fix_gv:
  3102.     if (lref && !GvCV(gv)) {
  3103.         SV *tmpsv;
  3104.         ENTER;
  3105.         tmpsv = NEWSV(704,0);
  3106.         gv_efullname(tmpsv, gv);
  3107.         newSUB(start_subparse(),
  3108.            newSVOP(OP_CONST, 0, tmpsv),
  3109.            Nullop,
  3110.            Nullop);
  3111.         LEAVE;
  3112.         if (!GvCV(gv))
  3113.         croak("Unable to create sub named \"%s\"", SvPV(sv,na));
  3114.     }
  3115.     return GvCV(gv);
  3116.     }
  3117. }
  3118.  
  3119. #ifndef SvTRUE
  3120. I32
  3121. SvTRUE(sv)
  3122. register SV *sv;
  3123. {
  3124.     if (!sv)
  3125.     return 0;
  3126.     if (SvGMAGICAL(sv))
  3127.     mg_get(sv);
  3128.     if (SvPOK(sv)) {
  3129.     register XPV* Xpv;
  3130.     if ((Xpv = (XPV*)SvANY(sv)) &&
  3131.         (*Xpv->xpv_pv > '0' ||
  3132.         Xpv->xpv_cur > 1 ||
  3133.         (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
  3134.         return 1;
  3135.     else
  3136.         return 0;
  3137.     }
  3138.     else {
  3139.     if (SvIOK(sv))
  3140.         return SvIVX(sv) != 0;
  3141.     else {
  3142.         if (SvNOK(sv))
  3143.         return SvNVX(sv) != 0.0;
  3144.         else
  3145.         return sv_2bool(sv);
  3146.     }
  3147.     }
  3148. }
  3149. #endif /* SvTRUE */
  3150.  
  3151. #ifndef SvIV
  3152. IV SvIV(Sv)
  3153. register SV *Sv;
  3154. {
  3155.     if (SvIOK(Sv))
  3156.     return SvIVX(Sv);
  3157.     return sv_2iv(Sv);
  3158. }
  3159. #endif /* SvIV */
  3160.  
  3161.  
  3162. #ifndef SvNV
  3163. double SvNV(Sv)
  3164. register SV *Sv;
  3165. {
  3166.     if (SvNOK(Sv))
  3167.     return SvNVX(Sv);
  3168.     if (SvIOK(Sv))
  3169.     return (double)SvIVX(Sv);
  3170.     return sv_2nv(Sv);
  3171. }
  3172. #endif /* SvNV */
  3173.  
  3174. #ifdef CRIPPLED_CC
  3175. char *
  3176. sv_pvn(sv, lp)
  3177. SV *sv;
  3178. STRLEN *lp;
  3179. {
  3180.     if (SvPOK(sv)) {
  3181.     *lp = SvCUR(sv);
  3182.     return SvPVX(sv);
  3183.     }
  3184.     return sv_2pv(sv, lp);
  3185. }
  3186. #endif
  3187.  
  3188. char *
  3189. sv_pvn_force(sv, lp)
  3190. SV *sv;
  3191. STRLEN *lp;
  3192. {
  3193.     char *s;
  3194.  
  3195.     if (SvREADONLY(sv) && curcop != &compiling)
  3196.     croak(no_modify);
  3197.     
  3198.     if (SvPOK(sv)) {
  3199.     *lp = SvCUR(sv);
  3200.     }
  3201.     else {
  3202.     if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
  3203.         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
  3204.         sv_unglob(sv);
  3205.         s = SvPVX(sv);
  3206.         *lp = SvCUR(sv);
  3207.         }
  3208.         else
  3209.         croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
  3210.             op_name[op->op_type]);
  3211.     }
  3212.     else
  3213.         s = sv_2pv(sv, lp);
  3214.     if (s != SvPVX(sv)) {    /* Almost, but not quite, sv_setpvn() */
  3215.         STRLEN len = *lp;
  3216.         
  3217.         if (SvROK(sv))
  3218.         sv_unref(sv);
  3219.         (void)SvUPGRADE(sv, SVt_PV);        /* Never FALSE */
  3220.         SvGROW(sv, len + 1);
  3221.         Move(s,SvPVX(sv),len,char);
  3222.         SvCUR_set(sv, len);
  3223.         *SvEND(sv) = '\0';
  3224.     }
  3225.     if (!SvPOK(sv)) {
  3226.         SvPOK_on(sv);        /* validate pointer */
  3227.         SvTAINT(sv);
  3228.         DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",
  3229.         (unsigned long)sv,SvPVX(sv)));
  3230.     }
  3231.     }
  3232.     return SvPVX(sv);
  3233. }
  3234.  
  3235. char *
  3236. sv_reftype(sv, ob)
  3237. SV* sv;
  3238. int ob;
  3239. {
  3240.     if (ob && SvOBJECT(sv))
  3241.     return HvNAME(SvSTASH(sv));
  3242.     else {
  3243.     switch (SvTYPE(sv)) {
  3244.     case SVt_NULL:
  3245.     case SVt_IV:
  3246.     case SVt_NV:
  3247.     case SVt_RV:
  3248.     case SVt_PV:
  3249.     case SVt_PVIV:
  3250.     case SVt_PVNV:
  3251.     case SVt_PVMG:
  3252.     case SVt_PVBM:
  3253.                 if (SvROK(sv))
  3254.                     return "REF";
  3255.                 else
  3256.                     return "SCALAR";
  3257.     case SVt_PVLV:        return "LVALUE";
  3258.     case SVt_PVAV:        return "ARRAY";
  3259.     case SVt_PVHV:        return "HASH";
  3260.     case SVt_PVCV:        return "CODE";
  3261.     case SVt_PVGV:        return "GLOB";
  3262.     case SVt_PVFM:        return "FORMLINE";
  3263.     default:        return "UNKNOWN";
  3264.     }
  3265.     }
  3266. }
  3267.  
  3268. int
  3269. sv_isobject(sv)
  3270. SV *sv;
  3271. {
  3272.     if (!SvROK(sv))
  3273.     return 0;
  3274.     sv = (SV*)SvRV(sv);
  3275.     if (!SvOBJECT(sv))
  3276.     return 0;
  3277.     return 1;
  3278. }
  3279.  
  3280. int
  3281. sv_isa(sv, name)
  3282. SV *sv;
  3283. char *name;
  3284. {
  3285.     if (!SvROK(sv))
  3286.     return 0;
  3287.     sv = (SV*)SvRV(sv);
  3288.     if (!SvOBJECT(sv))
  3289.     return 0;
  3290.  
  3291.     return strEQ(HvNAME(SvSTASH(sv)), name);
  3292. }
  3293.  
  3294. SV*
  3295. newSVrv(rv, classname)
  3296. SV *rv;
  3297. char *classname;
  3298. {
  3299.     SV *sv;
  3300.  
  3301.     new_SV();
  3302.     SvANY(sv) = 0;
  3303.     SvREFCNT(sv) = 0;
  3304.     SvFLAGS(sv) = 0;
  3305.     sv_upgrade(rv, SVt_RV);
  3306.     SvRV(rv) = SvREFCNT_inc(sv);
  3307.     SvROK_on(rv);
  3308.  
  3309.     if (classname) {
  3310.     HV* stash = gv_stashpv(classname, TRUE);
  3311.     (void)sv_bless(rv, stash);
  3312.     }
  3313.     return sv;
  3314. }
  3315.  
  3316. SV*
  3317. sv_setref_pv(rv, classname, pv)
  3318. SV *rv;
  3319. char *classname;
  3320. void* pv;
  3321. {
  3322.     if (!pv)
  3323.     sv_setsv(rv, &sv_undef);
  3324.     else
  3325.     sv_setiv(newSVrv(rv,classname), (IV)pv);
  3326.     return rv;
  3327. }
  3328.  
  3329. SV*
  3330. sv_setref_iv(rv, classname, iv)
  3331. SV *rv;
  3332. char *classname;
  3333. IV iv;
  3334. {
  3335.     sv_setiv(newSVrv(rv,classname), iv);
  3336.     return rv;
  3337. }
  3338.  
  3339. SV*
  3340. sv_setref_nv(rv, classname, nv)
  3341. SV *rv;
  3342. char *classname;
  3343. double nv;
  3344. {
  3345.     sv_setnv(newSVrv(rv,classname), nv);
  3346.     return rv;
  3347. }
  3348.  
  3349. SV*
  3350. sv_setref_pvn(rv, classname, pv, n)
  3351. SV *rv;
  3352. char *classname;
  3353. char* pv;
  3354. I32 n;
  3355. {
  3356.     sv_setpvn(newSVrv(rv,classname), pv, n);
  3357.     return rv;
  3358. }
  3359.  
  3360. SV*
  3361. sv_bless(sv,stash)
  3362. SV* sv;
  3363. HV* stash;
  3364. {
  3365.     SV *ref;
  3366.     if (!SvROK(sv))
  3367.         croak("Can't bless non-reference value");
  3368.     ref = SvRV(sv);
  3369.     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
  3370.     if (SvREADONLY(ref))
  3371.         croak(no_modify);
  3372.     if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
  3373.         --sv_objcount;
  3374.     }
  3375.     SvOBJECT_on(ref);
  3376.     ++sv_objcount;
  3377.     (void)SvUPGRADE(ref, SVt_PVMG);
  3378.     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
  3379.  
  3380. #ifdef OVERLOAD
  3381.     SvAMAGIC_off(sv);
  3382.     if (Gv_AMG(stash)) {
  3383.       SvAMAGIC_on(sv);
  3384.     }
  3385. #endif /* OVERLOAD */
  3386.  
  3387.     return sv;
  3388. }
  3389.  
  3390. static void
  3391. sv_unglob(sv)
  3392. SV* sv;
  3393. {
  3394.     assert(SvTYPE(sv) == SVt_PVGV);
  3395.     SvFAKE_off(sv);
  3396.     if (GvGP(sv))
  3397.     gp_free(sv);
  3398.     sv_unmagic(sv, '*');
  3399.     Safefree(GvNAME(sv));
  3400.     GvMULTI_off(sv);
  3401.     SvFLAGS(sv) &= ~SVTYPEMASK;
  3402.     SvFLAGS(sv) |= SVt_PVMG;
  3403. }
  3404.  
  3405. void
  3406. sv_unref(sv)
  3407. SV* sv;
  3408. {
  3409.     SV* rv = SvRV(sv);
  3410.     
  3411.     SvRV(sv) = 0;
  3412.     SvROK_off(sv);
  3413.     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
  3414.     SvREFCNT_dec(rv);
  3415.     else
  3416.     sv_2mortal(rv);        /* Schedule for freeing later */
  3417. }
  3418.  
  3419. #ifdef DEBUGGING
  3420. void
  3421. sv_dump(sv)
  3422. SV* sv;
  3423. {
  3424.     char tmpbuf[1024];
  3425.     char *d = tmpbuf;
  3426.     U32 flags;
  3427.     U32 type;
  3428.  
  3429.     if (!sv) {
  3430.     fprintf(stderr, "SV = 0\n");
  3431.     return;
  3432.     }
  3433.     
  3434.     flags = SvFLAGS(sv);
  3435.     type = SvTYPE(sv);
  3436.  
  3437.     sprintf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
  3438.     (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
  3439.     d += strlen(d);
  3440.     if (flags & SVs_PADBUSY)    strcat(d, "PADBUSY,");
  3441.     if (flags & SVs_PADTMP)    strcat(d, "PADTMP,");
  3442.     if (flags & SVs_PADMY)    strcat(d, "PADMY,");
  3443.     if (flags & SVs_TEMP)    strcat(d, "TEMP,");
  3444.     if (flags & SVs_OBJECT)    strcat(d, "OBJECT,");
  3445.     if (flags & SVs_GMG)    strcat(d, "GMG,");
  3446.     if (flags & SVs_SMG)    strcat(d, "SMG,");
  3447.     if (flags & SVs_RMG)    strcat(d, "RMG,");
  3448.     d += strlen(d);
  3449.  
  3450.     if (flags & SVf_IOK)    strcat(d, "IOK,");
  3451.     if (flags & SVf_NOK)    strcat(d, "NOK,");
  3452.     if (flags & SVf_POK)    strcat(d, "POK,");
  3453.     if (flags & SVf_ROK)    strcat(d, "ROK,");
  3454.     if (flags & SVf_OOK)    strcat(d, "OOK,");
  3455.     if (flags & SVf_FAKE)    strcat(d, "FAKE,");
  3456.     if (flags & SVf_READONLY)    strcat(d, "READONLY,");
  3457.     d += strlen(d);
  3458.  
  3459.     if (flags & SVp_IOK)    strcat(d, "pIOK,");
  3460.     if (flags & SVp_NOK)    strcat(d, "pNOK,");
  3461.     if (flags & SVp_POK)    strcat(d, "pPOK,");
  3462.     if (flags & SVp_SCREAM)    strcat(d, "SCREAM,");
  3463.     d += strlen(d);
  3464.     if (d[-1] == ',')
  3465.     d--;
  3466.     *d++ = ')';
  3467.     *d = '\0';
  3468.  
  3469.     fprintf(stderr, "SV = ");
  3470.     switch (type) {
  3471.     case SVt_NULL:
  3472.     fprintf(stderr,"NULL%s\n", tmpbuf);
  3473.     return;
  3474.     case SVt_IV:
  3475.     fprintf(stderr,"IV%s\n", tmpbuf);
  3476.     break;
  3477.     case SVt_NV:
  3478.     fprintf(stderr,"NV%s\n", tmpbuf);
  3479.     break;
  3480.     case SVt_RV:
  3481.     fprintf(stderr,"RV%s\n", tmpbuf);
  3482.     break;
  3483.     case SVt_PV:
  3484.     fprintf(stderr,"PV%s\n", tmpbuf);
  3485.     break;
  3486.     case SVt_PVIV:
  3487.     fprintf(stderr,"PVIV%s\n", tmpbuf);
  3488.     break;
  3489.     case SVt_PVNV:
  3490.     fprintf(stderr,"PVNV%s\n", tmpbuf);
  3491.     break;
  3492.     case SVt_PVBM:
  3493.     fprintf(stderr,"PVBM%s\n", tmpbuf);
  3494.     break;
  3495.     case SVt_PVMG:
  3496.     fprintf(stderr,"PVMG%s\n", tmpbuf);
  3497.     break;
  3498.     case SVt_PVLV:
  3499.     fprintf(stderr,"PVLV%s\n", tmpbuf);
  3500.     break;
  3501.     case SVt_PVAV:
  3502.     fprintf(stderr,"PVAV%s\n", tmpbuf);
  3503.     break;
  3504.     case SVt_PVHV:
  3505.     fprintf(stderr,"PVHV%s\n", tmpbuf);
  3506.     break;
  3507.     case SVt_PVCV:
  3508.     fprintf(stderr,"PVCV%s\n", tmpbuf);
  3509.     break;
  3510.     case SVt_PVGV:
  3511.     fprintf(stderr,"PVGV%s\n", tmpbuf);
  3512.     break;
  3513.     case SVt_PVFM:
  3514.     fprintf(stderr,"PVFM%s\n", tmpbuf);
  3515.     break;
  3516.     case SVt_PVIO:
  3517.     fprintf(stderr,"PVIO%s\n", tmpbuf);
  3518.     break;
  3519.     default:
  3520.     fprintf(stderr,"UNKNOWN%s\n", tmpbuf);
  3521.     return;
  3522.     }
  3523.     if (type >= SVt_PVIV || type == SVt_IV)
  3524.     fprintf(stderr, "  IV = %ld\n", (long)SvIVX(sv));
  3525.     if (type >= SVt_PVNV || type == SVt_NV)
  3526.     fprintf(stderr, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
  3527.     if (SvROK(sv)) {
  3528.     fprintf(stderr, "  RV = 0x%lx\n", (long)SvRV(sv));
  3529.     sv_dump(SvRV(sv));
  3530.     return;
  3531.     }
  3532.     if (type < SVt_PV)
  3533.     return;
  3534.     if (type <= SVt_PVLV) {
  3535.     if (SvPVX(sv))
  3536.         fprintf(stderr, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
  3537.         (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
  3538.     else
  3539.         fprintf(stderr, "  PV = 0\n");
  3540.     }
  3541.     if (type >= SVt_PVMG) {
  3542.     if (SvMAGIC(sv)) {
  3543.         fprintf(stderr, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
  3544.     }
  3545.     if (SvSTASH(sv))
  3546.         fprintf(stderr, "  STASH = %s\n", HvNAME(SvSTASH(sv)));
  3547.     }
  3548.     switch (type) {
  3549.     case SVt_PVLV:
  3550.     fprintf(stderr, "  TYPE = %c\n", LvTYPE(sv));
  3551.     fprintf(stderr, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
  3552.     fprintf(stderr, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
  3553.     fprintf(stderr, "  TARG = 0x%lx\n", (long)LvTARG(sv));
  3554.     sv_dump(LvTARG(sv));
  3555.     break;
  3556.     case SVt_PVAV:
  3557.     fprintf(stderr, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
  3558.     fprintf(stderr, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
  3559.     fprintf(stderr, "  FILL = %ld\n", (long)AvFILL(sv));
  3560.     fprintf(stderr, "  MAX = %ld\n", (long)AvMAX(sv));
  3561.     fprintf(stderr, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
  3562.     flags = AvFLAGS(sv);
  3563.     d = tmpbuf;
  3564.     if (flags & AVf_REAL)    strcat(d, "REAL,");
  3565.     if (flags & AVf_REIFY)    strcat(d, "REIFY,");
  3566.     if (flags & AVf_REUSED)    strcat(d, "REUSED,");
  3567.     if (*d)
  3568.         d[strlen(d)-1] = '\0';
  3569.     fprintf(stderr, "  FLAGS = (%s)\n", d);
  3570.     break;
  3571.     case SVt_PVHV:
  3572.     fprintf(stderr, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
  3573.     fprintf(stderr, "  KEYS = %ld\n", (long)HvKEYS(sv));
  3574.     fprintf(stderr, "  FILL = %ld\n", (long)HvFILL(sv));
  3575.     fprintf(stderr, "  MAX = %ld\n", (long)HvMAX(sv));
  3576.     fprintf(stderr, "  RITER = %ld\n", (long)HvRITER(sv));
  3577.     fprintf(stderr, "  EITER = 0x%lx\n",(long) HvEITER(sv));
  3578.     if (HvPMROOT(sv))
  3579.         fprintf(stderr, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
  3580.     if (HvNAME(sv))
  3581.         fprintf(stderr, "  NAME = \"%s\"\n", HvNAME(sv));
  3582.     break;
  3583.     case SVt_PVFM:
  3584.     case SVt_PVCV:
  3585.     fprintf(stderr, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
  3586.     fprintf(stderr, "  START = 0x%lx\n", (long)CvSTART(sv));
  3587.     fprintf(stderr, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
  3588.     fprintf(stderr, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
  3589.     fprintf(stderr, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
  3590.     fprintf(stderr, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
  3591.     fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
  3592.     fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
  3593.     fprintf(stderr, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
  3594.     if (type == SVt_PVFM)
  3595.         fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
  3596.     break;
  3597.     case SVt_PVGV:
  3598.     fprintf(stderr, "  NAME = %s\n", GvNAME(sv));
  3599.     fprintf(stderr, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
  3600.     fprintf(stderr, "  STASH = 0x%lx\n", (long)GvSTASH(sv));
  3601.     fprintf(stderr, "  GP = 0x%lx\n", (long)GvGP(sv));
  3602.     fprintf(stderr, "    SV = 0x%lx\n", (long)GvSV(sv));
  3603.     fprintf(stderr, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
  3604.     fprintf(stderr, "    IO = 0x%lx\n", (long)GvIOp(sv));
  3605.     fprintf(stderr, "    FORM = 0x%lx\n", (long)GvFORM(sv));
  3606.     fprintf(stderr, "    AV = 0x%lx\n", (long)GvAV(sv));
  3607.     fprintf(stderr, "    HV = 0x%lx\n", (long)GvHV(sv));
  3608.     fprintf(stderr, "    CV = 0x%lx\n", (long)GvCV(sv));
  3609.     fprintf(stderr, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
  3610.     fprintf(stderr, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
  3611.     fprintf(stderr, "    LINE = %ld\n", (long)GvLINE(sv));
  3612.     fprintf(stderr, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
  3613.     fprintf(stderr, "    STASH = 0x%lx\n", (long)GvSTASH(sv));
  3614.     fprintf(stderr, "    EGV = 0x%lx\n", (long)GvEGV(sv));
  3615.     break;
  3616.     case SVt_PVIO:
  3617.     fprintf(stderr, "  IFP = 0x%lx\n", (long)IoIFP(sv));
  3618.     fprintf(stderr, "  OFP = 0x%lx\n", (long)IoOFP(sv));
  3619.     fprintf(stderr, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
  3620.     fprintf(stderr, "  LINES = %ld\n", (long)IoLINES(sv));
  3621.     fprintf(stderr, "  PAGE = %ld\n", (long)IoPAGE(sv));
  3622.     fprintf(stderr, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
  3623.     fprintf(stderr, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
  3624.     fprintf(stderr, "  TOP_NAME = %s\n", IoTOP_NAME(sv));
  3625.     fprintf(stderr, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
  3626.     fprintf(stderr, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
  3627.     fprintf(stderr, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
  3628.     fprintf(stderr, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
  3629.     fprintf(stderr, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
  3630.     fprintf(stderr, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
  3631.     fprintf(stderr, "  TYPE = %c\n", IoTYPE(sv));
  3632.     fprintf(stderr, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
  3633.     break;
  3634.     }
  3635. }
  3636. #else
  3637. void
  3638. sv_dump(sv)
  3639. SV* sv;
  3640. {
  3641. }
  3642. #endif
  3643.  
  3644. IO*
  3645. sv_2io(sv)
  3646. SV *sv;
  3647. {
  3648.     IO* io;
  3649.     GV* gv;
  3650.  
  3651.     switch (SvTYPE(sv)) {
  3652.     case SVt_PVIO:
  3653.     io = (IO*)sv;
  3654.     break;
  3655.     case SVt_PVGV:
  3656.     gv = (GV*)sv;
  3657.     io = GvIO(gv);
  3658.     if (!io)
  3659.         croak("Bad filehandle: %s", GvNAME(gv));
  3660.     break;
  3661.     default:
  3662.     if (!SvOK(sv))
  3663.         croak(no_usym, "filehandle");
  3664.     if (SvROK(sv))
  3665.         return sv_2io(SvRV(sv));
  3666.     gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
  3667.     if (gv)
  3668.         io = GvIO(gv);
  3669.     else
  3670.         io = 0;
  3671.     if (!io)
  3672.         croak("Bad filehandle: %s", SvPV(sv,na));
  3673.     break;
  3674.     }
  3675.     return io;
  3676. }
  3677.  
  3678.